[MLton-commit] r4347
Matthew Fluet
MLton@mlton.org
Sun, 5 Feb 2006 06:22:38 -0800
Branching basis-library for refactoring
----------------------------------------------------------------------
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/signal.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/signal.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml
----------------------------------------------------------------------
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor (from rev 4344, mlton/branches/on-20050822-x86_64-branch/basis-library)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,82 +0,0 @@
-(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure C = struct
-
-
-(* C *)
-structure Char = struct open Int8 type t = int end
-structure SChar = struct open Int8 type t = int end
-structure UChar = struct open Word8 type t = word end
-structure Short = struct open Int16 type t = int end
-structure SShort = struct open Int16 type t = int end
-structure UShort = struct open Word16 type t = word end
-structure Int = struct open Int32 type t = int end
-structure SInt = struct open Int32 type t = int end
-structure UInt = struct open Word32 type t = word end
-structure Long = struct open Int32 type t = int end
-structure SLong = struct open Int32 type t = int end
-structure ULong = struct open Word32 type t = word end
-structure LongLong = struct open Int64 type t = int end
-structure SLongLong = struct open Int64 type t = int end
-structure ULongLong = struct open Word64 type t = word end
-structure Float = struct open Real32 type t = real end
-structure Double = struct open Real64 type t = real end
-structure Size = struct open Word32 type t = word end
-
-structure String = Pointer
-structure StringArray = Pointer
-
-(* Generic integers *)
-structure Fd = Int
-structure Signal = Int
-structure Status = Int
-structure Sock = Int
-
-(* C99 *)
-structure Intmax = struct open Int64 type t = int end
-structure UIntmax = struct open Word64 type t = word end
-
-(* from <dirent.h> *)
-structure DirP = struct open Word32 type t = word end
-
-(* from <poll.h> *)
-structure NFds = struct open Word32 type t = word end
-
-(* from <resource.h> *)
-structure RLim = struct open Word64 type t = word end
-
-(* from <sys/types.h> *)
-structure Clock = struct open Int32 type t = int end
-structure Dev = struct open Word64 type t = word end
-structure GId = struct open Word32 type t = word end
-structure Id = struct open Word32 type t = word end
-structure INo = struct open Word64 type t = word end
-structure Mode = struct open Word32 type t = word end
-structure NLink = struct open Word32 type t = word end
-structure Off = struct open Int64 type t = int end
-structure PId = struct open Int32 type t = int end
-structure SSize = struct open Int32 type t = int end
-structure SUSeconds = struct open Int32 type t = int end
-structure Time = struct open Int32 type t = int end
-structure UId = struct open Word32 type t = word end
-structure USeconds = struct open Word32 type t = word end
-
-(* from <sys/socket.h> *)
-structure Socklen = struct open Word32 type t = word end
-
-(* from <termios.h> *)
-structure CC = struct open Word8 type t = word end
-structure Speed = struct open Word32 type t = word end
-structure TCFlag = struct open Word32 type t = word end
-
-(* from "gmp.h" *)
-structure MPLimb = struct open Word32 type t = word end
-
-
-structure Errno = struct type 'a t = 'a end
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,78 +0,0 @@
-(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure C = struct
-
-
-(* C *)
-structure Char = struct open Int8 type t = int end
-structure SChar = struct open Int8 type t = int end
-structure UChar = struct open Word8 type t = word end
-structure Short = struct open Int16 type t = int end
-structure SShort = struct open Int16 type t = int end
-structure UShort = struct open Word16 type t = word end
-structure Int = struct open Int32 type t = int end
-structure SInt = struct open Int32 type t = int end
-structure UInt = struct open Word32 type t = word end
-structure Long = struct open Int32 type t = int end
-structure SLong = struct open Int32 type t = int end
-structure ULong = struct open Word32 type t = word end
-structure LongLong = struct open Int64 type t = int end
-structure SLongLong = struct open Int64 type t = int end
-structure ULongLong = struct open Word64 type t = word end
-structure Float = struct open Real32 type t = real end
-structure Double = struct open Real64 type t = real end
-structure Size = struct open Word32 type t = word end
-
-structure String = Pointer
-structure StringArray = Pointer
-
-(* Generic integers *)
-structure Fd = Int
-structure Signal = Int
-structure Status = Int
-structure Sock = Int
-
-(* from <dirent.h> *)
-structure DirP = struct open Word32 type t = word end
-
-(* from <poll.h> *)
-structure NFds = struct open Word32 type t = word end
-
-(* from <resource.h> *)
-structure RLim = struct open Word64 type t = word end
-
-(* from <sys/types.h> *)
-structure Clock = struct open Int32 type t = int end
-structure Dev = struct open Word64 type t = word end
-structure GId = struct open Word32 type t = word end
-structure Id = struct open Word32 type t = word end
-structure INo = struct open Word64 type t = word end
-structure Mode = struct open Word32 type t = word end
-structure NLink = struct open Word32 type t = word end
-structure Off = struct open Int64 type t = int end
-structure PId = struct open Int32 type t = int end
-structure SSize = struct open Int32 type t = int end
-structure SUSeconds = struct open Int32 type t = int end
-structure Time = struct open Int32 type t = int end
-structure UId = struct open Word32 type t = word end
-structure USeconds = struct open Word32 type t = word end
-
-(* from <sys/socket.h> *)
-structure Socklen = struct open Word32 type t = word end
-
-(* from <termios.h> *)
-structure CC = struct open Word8 type t = word end
-structure Speed = struct open Word32 type t = word end
-structure TCFlag = struct open Word32 type t = word end
-
-(* from "gmp.h" *)
-structure MPLimb = struct open Word32 type t = word end
-
-
-structure Errno = struct type 'a t = 'a end
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/config/choose.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,1032 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-(*
- * IntInf.int's either have a bottom bit of 1, in which case the top 31
- * bits are the signed integer, or else the bottom bit is 0, in which case
- * they point to an vector of Word.word's. The first word is either 0,
- * indicating that the number is positive, or 1, indicating that it is
- * negative. The rest of the vector contains the `limbs' (big digits) of
- * the absolute value of the number, from least to most significant.
- *)
-structure IntInf: INT_INF_EXTRA =
- struct
- structure Word = Word32
-
- datatype rep =
- Big of Word.word Vector.vector
- | Small of Int.int
-
- structure Prim = Primitive.IntInf
- type bigInt = Prim.int
- local
- open Int
- in
- val op < = op <
- val op <= = op <=
- val op > = op >
- val op >= = op >=
- val op + = op +
- val op - = op -
- end
- type smallInt = int
-
- (* bigIntConstant is just to make it easy to spot where the bigInt
- * constants are in this module.
- *)
- fun bigIntConstant x = x
- val zero = bigIntConstant 0
- val one = bigIntConstant 1
- val negOne = bigIntConstant ~1
-
- (* Check if an IntInf.int is small (i.e., a fixnum). *)
- fun isSmall (i: bigInt): bool =
- 0w0 <> Word.andb (Prim.toWord i, 0w1)
-
- (* Check if two IntInf.int's are both small (i.e., fixnums).
- * This is a gross hack, but uses only one test.
- *)
- fun areSmall (i: bigInt, i': bigInt) =
- 0w0 <> Word.andb (Prim.toWord i, Word.andb (Prim.toWord i', 0w1))
-
- (*
- * Return the number of `limbs' in a bigInt.
- * If arg is big, then |arg| is in [ 2^ (32 (x-1)), 2^ (32 x) )
- * where x is size arg. If arg is small, then it is in
- * [ - 2^30, 2^30 ).
- *)
- fun bigSize (arg: bigInt): smallInt =
- Vector.length (Prim.toVector arg) -? 1
- fun size (arg: bigInt): smallInt =
- if isSmall arg
- then 1
- else bigSize arg
-
- val bytesPerWord = 0w4
- (*
- * Reserve heap space for a bignum bigInt with room for size + extra
- * `limbs'. The reason for splitting this up is that extra is intended
- * to be a constant, and so can be combined at compile time with the 0w4
- * below.
- *)
- fun reserve (size: smallInt, extra: smallInt): word =
- Word.* (bytesPerWord,
- Word.+ (Word.fromInt size,
- Word.+ (0w4, (* counter, size, header, sign words *)
- Word.fromInt extra)))
-
- (*
- * Given a fixnum bigInt, return the Word.word which it
- * represents.
- * NOTE: it is an ERROR to call stripTag on an argument
- * which is a bignum bigInt.
- *)
- fun stripTag (arg: bigInt): Word.word =
- Word.~>> (Prim.toWord arg, 0w1)
-
- (*
- * Given a Word.word, add the tag bit in so that it looks like
- * a fixnum bigInt.
- *)
- fun addTag (argw: Word.word): Word.word =
- Word.orb (Word.<< (argw, 0w1), 0w1)
-
- (*
- * Given a fixnum bigInt, change the tag bit to 0.
- * NOTE: it is an ERROR to call zeroTag on an argument
- * which is a bignum bigInt.
- *)
- fun zeroTag (arg: bigInt): Word.word =
- Word.andb (Prim.toWord arg, 0wxFFFFFFFE)
-
- (*
- * Given a Word.word, set the tag bit back to 1.
- *)
- fun incTag (argw: Word.word): Word.word =
- Word.orb (argw, 0w1)
-
- (*
- * badw is the fixnum bigInt (as a word) whose negation and
- * absolute value are not fixnums. badv is the same thing
- * with the tag stripped off.
- * negBad is the negation (and absolute value) of that bigInt.
- *)
- val badw: Word.word = 0wx80000001 (* = Prim.toWord ~0x40000000 *)
- val badv: Word.word = 0wxC0000000 (* = stripTag ~0x40000000 *)
- val negBad: bigInt = bigIntConstant 0x40000000
-
- (*
- * Given two Word.word's, check if they have the same `sign' bit.
- *)
- fun sameSign (lhs: Word.word, rhs: Word.word): bool =
- Word.toIntX (Word.xorb (lhs, rhs)) >= 0
-
- (*
- * Given a bignum bigint, test if it is (strictly) negative.
- * Note: it is an ERROR to call bigIsNeg on an argument
- * which is a fixnum bigInt.
- *)
- fun bigIsNeg (arg: bigInt): bool =
- Primitive.Vector.sub (Prim.toVector arg, 0) <> 0w0
-
- (*
- * Convert a smallInt to a bigInt.
- *)
- fun bigFromInt (arg: smallInt): bigInt =
- let
- val argv = Word.fromInt arg
- val ans = addTag argv
- in
- if sameSign (argv, ans)
- then Prim.fromWord ans
- else let val space = Primitive.Array.array 2
- val (isneg, abs) = if arg < 0
- then (0w1, Word.- (0w0, argv))
- else (0w0, argv)
- val _ = Primitive.Array.update (space, 0, isneg)
- val _ = Primitive.Array.update (space, 1, abs)
- val space = Primitive.Vector.fromArray space
- in
- Prim.fromVector space
- end
- end
-
- fun rep x =
- if isSmall x
- then Small (Word.toIntX (stripTag x))
- else Big (Prim.toVector x)
-
- (*
- * Convert a bigInt to a smallInt, raising overflow if it
- * is too big.
- *)
- fun bigToInt (arg: bigInt): smallInt =
- if isSmall arg
- then Word.toIntX (stripTag arg)
- else if bigSize arg <> 1
- then raise Overflow
- else let val arga = Prim.toVector arg
- val argw = Primitive.Vector.sub (arga, 1)
- in if Primitive.Vector.sub (arga, 0) <> 0w0
- then if Word.<= (argw, 0wx80000000)
- then Word.toIntX (Word.- (0w0, argw))
- else raise Overflow
- else if Word.< (argw, 0wx80000000)
- then Word.toIntX argw
- else raise Overflow
- end
-
- fun bigFromInt64 (i: Int64.int): bigInt =
- if Int64.<= (~0x40000000, i) andalso Int64.<= (i, 0x3FFFFFFF)
- then Prim.fromWord (addTag (Word.fromInt (Int64.toInt i)))
- else
- let
- fun doit (i: Int64.int, isNeg): bigInt =
- if Int64.<= (i, 0xFFFFFFFF)
- then
- let
- val a = Primitive.Array.array 2
- val _ = Array.update (a, 0, isNeg)
- val _ = Array.update (a, 1, Int64.toWord i)
- in
- Prim.fromVector (Vector.fromArray a)
- end
- else
- let
- val a = Primitive.Array.array 3
- val _ = Array.update (a, 0, isNeg)
- val r = Int64.rem (i, 0x100000000)
- val _ = Array.update (a, 1, Int64.toWord r)
- val q = Int64.quot (i, 0x100000000)
- val _ = Array.update (a, 2, Int64.toWord q)
- in
- Prim.fromVector (Vector.fromArray a)
- end
- in
- if Int64.>= (i, 0)
- then doit (i, 0w0)
- else
- if i = valOf Int64.minInt
- then ~0x8000000000000000
- else doit (Int64.~? i, 0w1)
- end
-
- fun bigToInt64 (arg: bigInt): Int64.int =
- case rep arg of
- Small i => Int64.fromInt i
- | Big v =>
- if Vector.length v > 3
- then raise Overflow
- else let
- val sign = Primitive.Vector.sub (v, 0)
- val w1 = Primitive.Vector.sub (v, 1)
- val w2 = Primitive.Vector.sub (v, 2)
- in
- if Word.> (w2, 0wx80000000)
- then raise Overflow
- else if w2 = 0wx80000000
- then if w1 = 0w0 andalso sign = 0w1
- then valOf Int64.minInt
- else raise Overflow
- else
- let
- val n =
- Int64.+?
- (Primitive.Int64.fromWord w1,
- Int64.*? (Primitive.Int64.fromWord w2,
- 0x100000000))
- in
- if sign = 0w1
- then Int64.~ n
- else n
- end
- end
-
- (*
- * bigInt negation.
- *)
- fun bigNegate (arg: bigInt): bigInt =
- if isSmall arg
- then let val argw = Prim.toWord arg
- in if argw = badw
- then negBad
- else Prim.fromWord (Word.- (0w2, argw))
- end
- else Prim.~ (arg, reserve (bigSize arg, 1))
-
- val dontInline: (unit -> 'a) -> 'a =
- fn f =>
- let
- val rec recur: int -> 'a =
- fn i =>
- if i = 0
- then f ()
- else (ignore (recur (i - 1))
- ; recur (i - 2))
- in
- recur 0
- end
-
- (*
- * bigInt multiplication.
- *)
- local
- val carry: Word.word ref = ref 0w0
- in
- fun bigMul (lhs: bigInt, rhs: bigInt): bigInt =
- let
- val res =
- if areSmall (lhs, rhs)
- then let
- val lhsv = stripTag lhs
- val rhs0 = zeroTag rhs
- val ans0 = Prim.smallMul (lhsv, rhs0, carry)
- in
- if (! carry) = Word.~>> (ans0, 0w31)
- then SOME (Prim.fromWord (incTag ans0))
- else NONE
- end
- else NONE
- in
- case res of
- NONE =>
- dontInline
- (fn () =>
- Prim.* (lhs, rhs, reserve (size lhs +? size rhs, 0)))
- | SOME i => i
- end
- end
-
- (*
- * bigInt quot.
- * Round towards 0 (bigRem returns the remainder).
- * Note, if size num < size den, then the answer is 0.
- * The only non-trivial case here is num being - den,
- * and small, but in that case, although den may be big, its
- * size is still 1. (den cannot be 0 in this case.)
- * The space required for the shifted numerator limbs is <= nsize + 1.
- * The space required for the shifted denominator limbs is <= dsize
- * The space required for the quotient limbs is <= 1 + nsize - dsize.
- * Thus the total space for limbs is <= 2*nsize + 2 (and one extra
- * word for the isNeg flag).
- *)
- fun bigQuot (num: bigInt, den: bigInt): bigInt =
- if areSmall (num, den)
- then let val numv = stripTag num
- val denv = stripTag den
- in if numv = badv andalso denv = Word.fromInt ~1
- then negBad
- else let val numi = Word.toIntX numv
- val deni = Word.toIntX denv
- val ansi = Int.quot (numi, deni)
- val answ = Word.fromInt ansi
- in Prim.fromWord (addTag answ)
- end
- end
- else let val nsize = size num
- val dsize = size den
- in if nsize < dsize
- then zero
- else if den = zero
- then raise Div
- else
- Prim.quot
- (num, den,
- Word.* (Word.* (0w2, bytesPerWord),
- Word.+ (Word.fromInt nsize, 0w3)))
- end
-
- (*
- * bigInt rem.
- * Sign taken from numerator, quotient is returned by bigQuot.
- * Note, if size num < size den, then the answer is 0.
- * The only non-trivial case here is num being - den,
- * and small, but in that case, although den may be big, its
- * size is still 1. (den cannot be 0 in this case.)
- * The space required for the shifted numerator limbs is <= nsize + 1.
- * The space required for the shifted denominator limbs is <= dsize
- * The space required for the quotient limbs is <= 1 + nsize - dsize.
- * Thus the total space for limbs is <= 2*nsize + 2 (and one extra
- * word for the isNeg flag).
- *)
- fun bigRem (num: bigInt, den: bigInt): bigInt =
- if areSmall (num, den)
- then let val numv = stripTag num
- val numi = Word.toIntX numv
- val denv = stripTag den
- val deni = Word.toIntX denv
- val ansi = Int.rem (numi, deni)
- val answ = Word.fromInt ansi
- in Prim.fromWord (addTag answ)
- end
- else let val nsize = size num
- val dsize = size den
- in if nsize < dsize
- then num
- else if den = zero
- then raise Div
- else
- Prim.rem
- (num, den, Word.* (Word.* (0w2, bytesPerWord),
- Word.+ (Word.fromInt nsize, 0w3)))
- end
-
- (*
- * bigInt addition.
- *)
- fun bigPlus (lhs: bigInt, rhs: bigInt): bigInt =
- let
- val res =
- if areSmall (lhs, rhs)
- then let val ansv = Word.+ (stripTag lhs, stripTag rhs)
- val ans = addTag ansv
- in if sameSign (ans, ansv)
- then SOME (Prim.fromWord ans)
- else NONE
- end
- else NONE
- in
- case res of
- NONE =>
- dontInline
- (fn () =>
- Prim.+ (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
- | SOME i => i
- end
-
- (*
- * bigInt subtraction.
- *)
- fun bigMinus (lhs: bigInt, rhs: bigInt): bigInt =
- let
- val res =
- if areSmall (lhs, rhs)
- then
- let
- val ansv = Word.- (stripTag lhs, stripTag rhs)
- val ans = addTag ansv
- in
- if sameSign (ans, ansv)
- then SOME (Prim.fromWord ans)
- else NONE
- end
- else NONE
- in
- case res of
- NONE =>
- dontInline
- (fn () =>
- Prim.- (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
- | SOME i => i
- end
-
- (*
- * bigInt compare.
- *)
- fun bigCompare (lhs: bigInt, rhs: bigInt): order =
- if areSmall (lhs, rhs)
- then Int.compare (Word.toIntX (Prim.toWord lhs),
- Word.toIntX (Prim.toWord rhs))
- else Int.compare (Prim.compare (lhs, rhs), 0)
-
-
- (*
- * bigInt comparisions.
- *)
- local
- fun makeTest (smallTest: smallInt * smallInt -> bool)
- (lhs: bigInt, rhs: bigInt): bool =
- if areSmall (lhs, rhs)
- then smallTest (Word.toIntX (Prim.toWord lhs),
- Word.toIntX (Prim.toWord rhs))
- else smallTest (Prim.compare (lhs, rhs), 0)
- in
- val bigGT = makeTest (op >)
- val bigGE = makeTest (op >=)
- val bigLE = makeTest (op <=)
- val bigLT = makeTest (op <)
- end
-
- (*
- * bigInt abs.
- *)
- fun bigAbs (arg: bigInt): bigInt =
- if isSmall arg
- then let val argw = Prim.toWord arg
- in if argw = badw
- then negBad
- else if Word.toIntX argw < 0
- then Prim.fromWord (Word.- (0w2, argw))
- else arg
- end
- else if bigIsNeg arg
- then Prim.~ (arg, reserve (bigSize arg, 1))
- else arg
-
- (*
- * bigInt min.
- *)
- fun bigMin (lhs: bigInt, rhs: bigInt): bigInt =
- if bigLE (lhs, rhs)
- then lhs
- else rhs
-
- (*
- * bigInt max.
- *)
- fun bigMax (lhs: bigInt, rhs: bigInt): bigInt =
- if bigLE (lhs, rhs)
- then rhs
- else lhs
-
- (*
- * bigInt sign.
- *)
- fun bigSign (arg: bigInt): smallInt =
- if isSmall arg
- then Int.sign (Word.toIntX (stripTag arg))
- else if bigIsNeg arg
- then ~1
- else 1
-
- (*
- * bigInt sameSign.
- *)
- fun bigSameSign (lhs: bigInt, rhs: bigInt): bool =
- bigSign lhs = bigSign rhs
-
- (*
- * bigInt gcd.
- * based on code from PolySpace.
- *)
- local
- open Int
-
- fun mod2 x = Word.toIntX (Word.andb (Word.fromInt x, 0w1))
- fun div2 x = Word.toIntX (Word.>> (Word.fromInt x, 0w1))
-
- fun gcdInt (a, b, acc) =
- case (a, b) of
- (0, _) => b * acc
- | (_, 0) => a * acc
- | (_, 1) => acc
- | (1, _) => acc
- | _ =>
- if a = b
- then a * acc
- else
- let
- val a_2 = div2 a
- val a_r2 = mod2 a
- val b_2 = div2 b
- val b_r2 = mod2 b
- in
- if 0 = a_r2
- then
- if 0 = b_r2
- then gcdInt (a_2, b_2, acc + acc)
- else gcdInt (a_2, b, acc)
- else
- if 0 = b_r2
- then gcdInt (a, b_2, acc)
- else
- if a >= b
- then gcdInt (div2 (a - b), b, acc)
- else gcdInt (a, div2 (b - a), acc)
- end
-
- in
- fun bigGcd (lhs: bigInt, rhs: bigInt): bigInt =
- if areSmall (lhs, rhs)
- then
- Prim.fromWord
- (addTag
- (Word.fromInt
- (gcdInt (Int.abs (Word.toIntX (stripTag lhs)),
- Int.abs (Word.toIntX (stripTag rhs)),
- 1))))
- else Prim.gcd (lhs, rhs, reserve (max (size lhs, size rhs), 0))
- end
-
- (*
- * bigInt toString and fmt.
- * dpc is the maximum number of digits per `limb'.
- *)
- local
- open StringCvt
-
- fun cvt {base: smallInt,
- dpc: word,
- smallCvt: smallInt -> string}
- (arg: bigInt)
- : string =
- if isSmall arg
- then smallCvt (Word.toIntX (stripTag arg))
- else Prim.toString (arg, base,
- Word.+
- (reserve (0, 0),
- Word.+ (0w2, (* sign character *)
- Word.* (dpc,
- Word.fromInt (bigSize arg)))))
- val binCvt = cvt {base = 2, dpc = 0w32, smallCvt = Int.fmt BIN}
- val octCvt = cvt {base = 8, dpc = 0w11, smallCvt = Int.fmt OCT}
- val hexCvt = cvt {base = 16, dpc = 0w8, smallCvt = Int.fmt HEX}
- in
- val bigToString = cvt {base = 10,
- dpc = 0w10,
- smallCvt = Int.toString}
- fun bigFmt radix =
- case radix of
- BIN => binCvt
- | OCT => octCvt
- | DEC => bigToString
- | HEX => hexCvt
- end
-
- (*
- * bigInt scan and fromString.
- *)
- local
- open StringCvt
-
- (*
- * We use Word.word to store chunks of digits.
- * smallToInf converts such a word to a fixnum bigInt.
- * Thus, it can only represent values in [- 2^30, 2^30).
- *)
- fun smallToBig (arg: Word.word): bigInt =
- Prim.fromWord (addTag arg)
-
-
- (*
- * Given a char, if it is a digit in the appropriate base,
- * convert it to a word. Otherwise, return NONE.
- * Note, both a-f and A-F are accepted as hexadecimal digits.
- *)
- fun binDig (ch: char): Word.word option =
- case ch of
- #"0" => SOME 0w0
- | #"1" => SOME 0w1
- | _ => NONE
-
- local
- val op <= = Char.<=
- in
- fun octDig (ch: char): Word.word option =
- if #"0" <= ch andalso ch <= #"7"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
- else NONE
-
- fun decDig (ch: char): Word.word option =
- if #"0" <= ch andalso ch <= #"9"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
- else NONE
-
- fun hexDig (ch: char): Word.word option =
- if #"0" <= ch andalso ch <= #"9"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
- else if #"a" <= ch andalso ch <= #"f"
- then SOME (Word.fromInt (ord ch -? (ord #"a" - 0xa)))
- else if #"A" <= ch andalso ch <= #"F"
- then SOME (Word.fromInt
- (ord ch -? (ord #"A" - 0xA)))
- else
- NONE
- end
-
- (*
- * Given a digit converter and a char reader, return a digit
- * reader.
- *)
- fun toDigR (charToDig: char -> Word.word option,
- cread: (char, 'a) reader)
- (s: 'a)
- : (Word.word * 'a) option =
- case cread s of
- NONE => NONE
- | SOME (ch, s') =>
- case charToDig ch of
- NONE => NONE
- | SOME dig => SOME (dig, s')
-
- (*
- * A chunk represents the result of processing some digits.
- * more is a bool indicating if there might be more digits.
- * shift is base raised to the number-of-digits-seen power.
- * chunk is the value of the digits seen.
- *)
- type chunk = {
- more: bool,
- shift: Word.word,
- chunk: Word.word
- }
-
- (*
- * Given the base, the number of digits per chunk,
- * a char reader and a digit reader, return a chunk reader.
- *)
- fun toChunkR (base: Word.word,
- dpc: smallInt,
- dread: (Word.word, 'a) reader)
- : (chunk, 'a) reader =
- let fun loop {left: smallInt,
- shift: Word.word,
- chunk: Word.word,
- s: 'a}
- : chunk * 'a =
- if left <= 0
- then ({more = true,
- shift = shift,
- chunk = chunk },
- s)
- else
- case dread s of
- NONE => ({more = false,
- shift = shift,
- chunk = chunk},
- s)
- | SOME (dig, s') =>
- loop {
- left = left - 1,
- shift = Word.* (base, shift),
- chunk = Word.+ (Word.* (base,
- chunk),
- dig),
- s = s'
- }
- fun reader (s: 'a): (chunk * 'a) option =
- case dread s of
- NONE => NONE
- | SOME (dig, next) =>
- SOME (loop {left = dpc - 1,
- shift = base,
- chunk = dig,
- s = next})
- in reader
- end
-
- (*
- * Given a chunk reader, return an unsigned reader.
- *)
- fun toUnsR (ckread: (chunk, 'a) reader): (bigInt, 'a) reader =
- let fun loop (more: bool, ac: bigInt, s: 'a) =
- if more
- then case ckread s of
- NONE => (ac, s)
- | SOME ({more, shift, chunk}, s') =>
- loop (more,
- bigPlus (bigMul (smallToBig shift,
- ac),
- smallToBig chunk),
- s')
- else (ac, s)
- fun reader (s: 'a): (bigInt * 'a) option =
- case ckread s of
- NONE => NONE
- | SOME ({more, chunk, ...}, s') =>
- SOME (loop (more,
- smallToBig chunk,
- s'))
- in reader
- end
-
- (*
- * Given a char reader and an unsigned reader, return an unsigned
- * reader that includes skipping the option hex '0x'.
- *)
- fun toHexR (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
- s =
- case cread s of
- NONE => NONE
- | SOME (c1, s1) =>
- if c1 = #"0" then
- case cread s1 of
- NONE => SOME (zero, s1)
- | SOME (c2, s2) =>
- if c2 = #"x" orelse c2 = #"X" then
- case uread s2 of
- NONE => SOME (zero, s1)
- | SOME x => SOME x
- else uread s
- else uread s
-
- (*
- * Given a char reader and an unsigned reader, return a signed
- * reader. This includes skipping any initial white space.
- *)
- fun toSign (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
- : (bigInt, 'a) reader =
- let
- fun reader (s: 'a): (bigInt * 'a) option =
- case cread s of
- NONE => NONE
- | SOME (ch, s') =>
- if Char.isSpace ch then reader s'
- else
- let
- val (isNeg, s'') =
- case ch of
- #"+" => (false, s')
- | #"-" => (true, s')
- | #"~" => (true, s')
- | _ => (false, s)
- in
- if isNeg then
- case uread s'' of
- NONE => NONE
- | SOME (abs, s''') =>
- SOME (bigNegate abs, s''')
- else uread s''
- end
- in
- reader
- end
-
- (*
- * Base-specific conversions from char readers to
- * bigInt readers.
- *)
- local
- fun reader (base, dpc, dig)
- (cread: (char, 'a) reader): (bigInt, 'a) reader =
- let val dread = toDigR (dig, cread)
- val ckread = toChunkR (base, dpc, dread)
- val uread = toUnsR ckread
- val hread =
- if base = 0w16 then toHexR (cread, uread) else uread
- val reader = toSign (cread, hread)
- in reader
- end
- in
- fun binReader z = reader (0w2, 29, binDig) z
- fun octReader z = reader (0w8, 9, octDig) z
- fun decReader z = reader (0w10, 9, decDig) z
- fun hexReader z = reader (0w16, 7, hexDig) z
- end
- in
-
- local fun stringReader (pos, str) =
- if pos >= String.size str
- then NONE
- else SOME (String.sub (str, pos), (pos + 1, str))
- val reader = decReader stringReader
- in
- fun bigFromString str =
- case reader (0, str) of
- NONE => NONE
- | SOME (res, _) => SOME res
- end
-
- fun bigScan radix =
- case radix of
- BIN => binReader
- | OCT => octReader
- | DEC => decReader
- | HEX => hexReader
- end
-
- local
- fun isEven (n: int) = Int.mod (Int.abs n, 2) = 0
- in
- fun pow (i: bigInt, j: int): bigInt =
- if j < 0 then
- if i = zero then
- raise Div
- else
- if i = one then one
- else if i = negOne then if isEven j then one else negOne
- else zero
- else
- if j = 0 then one
- else
- let
- fun square (n: bigInt): bigInt = bigMul (n, n)
- (* pow (j) returns (i ^ j) *)
- fun pow (j: int): bigInt =
- if j <= 0 then one
- else if isEven j then evenPow j
- else bigMul (i, evenPow (j - 1))
- (* evenPow (j) returns (i ^ j), assuming j is even *)
- and evenPow (j: int): bigInt =
- square (pow (Int.quot (j, 2)))
- in pow (j)
- end
- end
-
- val op + = bigPlus
- val op - = bigMinus
- val op > = bigGT
- val op >= = bigGE
- val op < = bigLT
- val quot = bigQuot
- val rem = bigRem
-
- fun x div y =
- if x >= zero
- then if y > zero
- then quot (x, y)
- else if y < zero
- then if x = zero
- then zero
- else quot (x - one, y) - one
- else raise Div
- else if y < zero
- then quot (x, y)
- else if y > zero
- then quot (x + one, y) - one
- else raise Div
-
- fun x mod y =
- if x >= zero
- then if y > zero
- then rem (x, y)
- else if y < zero
- then if x = zero
- then zero
- else rem (x - one, y) + (one + y)
- else raise Div
- else if y < zero
- then rem (x, y)
- else if y > zero
- then rem (x + one, y) + (y - one)
- else raise Div
-
- fun divMod (x, y) = (x div y, x mod y)
- fun quotRem (x, y) = (quot (x, y), rem (x, y))
-
- (*
- * bigInt log2
- *)
- structure Word =
- struct
- open Word
- fun log2 (w: word): int =
- let
- fun loop (n, s, ac): word =
- if n = 0w1
- then ac
- else
- let
- val (n, ac) =
- if n >= << (0w1, s)
- then (>> (n, s), ac + s)
- else (n, ac)
- in
- loop (n, >> (s, 0w1), ac)
- end
- in
- toInt (loop (w, 0w16, 0w0))
- end
- end
-
- local
- val bitsPerLimb: Int.int = 32
- in
- fun log2 (n: bigInt): Int.int =
- if bigLE (n, 0)
- then raise Domain
- else
- case rep n of
- Big v =>
- Int.+ (Int.* (bitsPerLimb, Int.- (Vector.length v, 2)),
- Word.log2 (Vector.sub (v, Int.- (Vector.length v, 1))))
- | Small i => Word.log2 (Word.fromInt i)
- end
-
- (*
- * bigInt bit operations.
- *)
- local
- fun make (wordOp, bigIntOp): bigInt * bigInt -> bigInt =
- fn (lhs: bigInt, rhs: bigInt) =>
- if areSmall (lhs, rhs)
- then
- let
- val ansv = wordOp (stripTag lhs, stripTag rhs)
- val ans = addTag ansv
- in
- Prim.fromWord ans
- end
- else
- dontInline
- (fn () =>
- bigIntOp (lhs, rhs, reserve (Int.max (size lhs, size rhs), 0)))
- in
- val bigAndb = make (Word.andb, Prim.andb)
- val bigOrb = make (Word.orb, Prim.orb)
- val bigXorb = make (Word.xorb, Prim.xorb)
- end
-
- fun bigNotb (arg: bigInt): bigInt =
- if isSmall arg
- then Prim.fromWord (addTag (Word.notb (stripTag arg)))
- else dontInline (fn () => Prim.notb (arg, reserve (size arg, 0)))
-
- local
- val bitsPerLimb : Word.word = 0w32
- fun shiftSize shift = Word.toIntX (Word.div (shift, bitsPerLimb))
- in
- fun bigArshift (arg: bigInt, shift: word): bigInt =
- if shift = 0wx0
- then arg
- else Prim.~>> (arg, shift,
- reserve (Int.max (1, size arg -? shiftSize shift),
- 0))
-
- fun bigLshift (arg: bigInt, shift: word): bigInt =
- if shift = 0wx0
- then arg
- else Prim.<< (arg, shift, reserve (size arg +? shiftSize shift, 1))
- end
-
- type int = bigInt
- val abs = bigAbs
- val compare = bigCompare
- val divMod = divMod
- val fmt = bigFmt
- val fromInt = bigFromInt
- val fromInt64 = bigFromInt64
- val fromLarge = fn x => x
- val fromString = bigFromString
- val gcd = bigGcd
- val max = bigMax
- val maxInt = NONE
- val min = bigMin
- val minInt = NONE
- val op * = bigMul
- val op + = bigPlus
- val op - = bigMinus
- val op < = bigLT
- val op <= = bigLE
- val op > = bigGT
- val op >= = bigGE
- val op div = op div
- val op mod = op mod
- val pow = pow
- val precision = NONE
- val quot = bigQuot
- val quotRem = quotRem
- val rem = bigRem
- val rep = rep
- val sameSign = bigSameSign
- val scan = bigScan
- val sign = bigSign
- val toInt = bigToInt
- val toInt64 = bigToInt64
- val toLarge = fn x => x
- val toString = bigToString
- val ~ = bigNegate
- val andb = bigAndb
- val notb = bigNotb
- val orb = bigOrb
- val xorb = bigXorb
- val ~>> = bigArshift
- val << = bigLshift
- end
-
-structure LargeInt = IntInf
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,41 +0,0 @@
-(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure Exit =
- struct
- structure Status =
- struct
- type t = C.Status.t
- val fromInt =C.Status.fromInt
- val toInt = C.Status.toInt
- val failure = fromInt 1
- val success = fromInt 0
- end
-
- val exiting = ref false
-
- fun atExit f =
- if !exiting
- then ()
- else Cleaner.addNew (Cleaner.atExit, f)
-
- fun exit (status: Status.t): 'a =
- if !exiting
- then raise Fail "exit"
- else
- let
- val _ = exiting := true
- val i = Status.toInt status
- in
- if 0 <= i andalso i < 256
- then (let open Cleaner in clean atExit end
- ; Primitive.halt status
- ; raise Fail "exit")
- else raise Fail (concat ["exit must have 0 <= status < 256: saw ",
- Int.toString i])
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,30 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure MLtonProcEnv: MLTON_PROC_ENV =
- struct
- type gid = C.GId.t
-
- fun setenv {name, value} =
- let
- val name = NullString.nullTerm name
- val value = NullString.nullTerm value
- in
- PosixError.SysCall.simple
- (fn () => PrimitiveFFI.Posix.ProcEnv.setenv (name, value))
- end
-
- fun setgroups gs =
- let
- val v = Vector.fromList gs
- val n = Vector.length v
- in
- PosixError.SysCall.simple
- (fn () => PrimitiveFFI.Posix.ProcEnv.setgroups (n, v))
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,44 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure MLtonRlimit: MLTON_RLIMIT =
- struct
- open PrimitiveFFI.MLton.Rlimit
- type rlim = C.RLim.t
- type t = C.Int.t
-
- val get =
- fn (r: t) =>
- PosixError.SysCall.syscall
- (fn () =>
- (get r, fn () =>
- {hard = getHard (),
- soft = getSoft ()}))
-
- val set =
- fn (r: t, {hard, soft}) =>
- PosixError.SysCall.simple
- (fn () => set (r, hard, soft))
-
- val infinity = INFINITY
-
- val coreFileSize = CORE
- val cpuTime = CPU
- val dataSize = DATA
- val fileSize = FSIZE
- val numFiles = NOFILE
- val stackSize = STACK
- val virtualMemorySize = AS
-
-(* NOT STANDARD
- val lockedInMemorySize = MEMLOCK
- val numProcesses = NPROC
- val residentSetSize = RSS
-*)
-
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,227 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure MLtonSignal: MLTON_SIGNAL_EXTRA =
-struct
-
-open Posix.Signal
-structure Prim = PrimitiveFFI.Posix.Signal
-structure Error = PosixError
-structure SysCall = Error.SysCall
-val restart = SysCall.restartFlag
-
-type t = signal
-
-type how = C.Int.t
-
-(* val toString = SysWord.toString o toWord *)
-
-fun raiseInval () =
- let
- open PosixError
- in
- raiseSys inval
- end
-
-val validSignals =
- Array.tabulate
- (Prim.NSIG, fn i =>
- Prim.sigismember(fromInt i) <> ~1)
-
-structure Mask =
- struct
- datatype t =
- AllBut of signal list
- | Some of signal list
-
- val allBut = AllBut
- val some = Some
-
- val all = allBut []
- val none = some []
-
- fun read () =
- Some
- (Array.foldri
- (fn (i, b, sigs) =>
- if b
- then if (Prim.sigismember(fromInt i)) = 1
- then (fromInt i)::sigs
- else sigs
- else sigs)
- []
- validSignals)
-
- fun write m =
- case m of
- AllBut signals =>
- (SysCall.simple Prim.sigfillset
- ; List.app (fn s => SysCall.simple (fn () => Prim.sigdelset s)) signals)
- | Some signals =>
- (SysCall.simple Prim.sigemptyset
- ; List.app (fn s => SysCall.simple (fn () => Prim.sigaddset s)) signals)
-
- local
- fun make (how: how) (m: t) =
- (write m; SysCall.simpleRestart (fn () => Prim.sigprocmask how))
- in
- val block = make Prim.SIG_BLOCK
- val unblock = make Prim.SIG_UNBLOCK
- val setBlocked = make Prim.SIG_SETMASK
- fun getBlocked () = (make Prim.SIG_BLOCK none; read ())
- end
-
- local
- fun member (sigs, s) = List.exists (fn s' => s = s') sigs
- in
- fun isMember (mask, s) =
- if Array.sub (validSignals, toInt s)
- then case mask of
- AllBut sigs => not (member (sigs, s))
- | Some sigs => member (sigs, s)
- else raiseInval ()
- end
- end
-
-structure Handler =
- struct
- datatype t =
- Default
- | Handler of MLtonThread.Runnable.t -> MLtonThread.Runnable.t
- | Ignore
- | InvalidSignal
- end
-
-datatype handler = datatype Handler.t
-
-local
- val r = ref false
-in
- fun initHandler (s: signal): Handler.t =
- if 0 = Prim.isDefault (s, r)
- then if !r
- then Default
- else Ignore
- else InvalidSignal
-end
-
-val (getHandler, setHandler, handlers) =
- let
- val handlers = Array.tabulate (Prim.NSIG, initHandler o fromInt)
- val _ =
- Cleaner.addNew
- (Cleaner.atLoadWorld, fn () =>
- Array.modifyi (initHandler o fromInt o #1) handlers)
- in
- (fn s: t => Array.sub (handlers, toInt s),
- fn (s: t, h) => if Primitive.MLton.Profile.isOn andalso s = prof
- then raiseInval ()
- else Array.update (handlers, toInt s, h),
- handlers)
- end
-
-val gcHandler = ref Ignore
-
-fun handled () =
- Mask.some
- (Array.foldri
- (fn (s, h, sigs) =>
- case h of
- Handler _ => (fromInt s)::sigs
- | _ => sigs) [] handlers)
-
-structure Handler =
- struct
- open Handler
-
- val default = Default
- val ignore = Ignore
-
- val isDefault = fn Default => true | _ => false
- val isIgnore = fn Ignore => true | _ => false
-
- val handler =
- (* This let is used so that Thread.setHandler is only used if
- * Handler.handler is used. This prevents threads from being part
- * of every program.
- *)
- let
- (* As far as C is concerned, there is only one signal handler.
- * As soon as possible after a C signal is received, this signal
- * handler walks over the array of all SML handlers, and invokes any
- * one for which a C signal has been received.
- *
- * Any exceptions raised by a signal handler will be caught by
- * the topLevelHandler, which is installed in thread.sml.
- *)
- val _ =
- PosixError.SysCall.blocker :=
- (fn () => let
- val m = Mask.getBlocked ()
- val () = Mask.block (handled ())
- in
- fn () => Mask.setBlocked m
- end)
-
- val () =
- MLtonThread.setSignalHandler
- (fn t =>
- let
- val mask = Mask.getBlocked ()
- val () = Mask.block (handled ())
- val fs =
- case !gcHandler of
- Handler f => if Prim.isPendingGC () then [f] else []
- | _ => []
- val fs =
- Array.foldri
- (fn (s, h, fs) =>
- case h of
- Handler f =>
- if Prim.isPending (fromInt s) then f::fs else fs
- | _ => fs) fs handlers
- val () = Prim.resetPending ()
- val () = Mask.setBlocked mask
- in
- List.foldl (fn (f, t) => f t) t fs
- end)
- in
- Handler
- end
-
- fun simple (f: unit -> unit) = handler (fn t => (f (); t))
- end
-
-val setHandler = fn (s, h) =>
- case (getHandler s, h) of
- (InvalidSignal, _) => raiseInval ()
- | (_, InvalidSignal) => raiseInval ()
- | (Default, Default) => ()
- | (_, Default) =>
- (setHandler (s, Default)
- ; SysCall.simpleRestart (fn () => Prim.default s))
- | (Handler _, Handler _) =>
- setHandler (s, h)
- | (_, Handler _) =>
- (setHandler (s, h)
- ; SysCall.simpleRestart (fn () => Prim.handlee s))
- | (Ignore, Ignore) => ()
- | (_, Ignore) =>
- (setHandler (s, Ignore)
- ; SysCall.simpleRestart (fn () => Prim.ignore s))
-
-fun suspend m =
- (Mask.write m
- ; Prim.sigsuspend ()
- ; MLtonThread.switchToSignalHandler ())
-
-fun handleGC f =
- (Prim.handleGC ()
- ; gcHandler := Handler.simple f)
-
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,89 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-(* From Tom 7 <twm@andrew.cmu.edu>. *)
-(* Implementation of the SYSLOG interface using MLton FFI.
- * This will only work in MLton.
- *)
-
-structure MLtonSyslog :> MLTON_SYSLOG =
-struct
-
-open PrimitiveFFI.MLton.Syslog
-
-type openflag = C.Int.t
-
-local
- open Logopt
-in
- val CONS = LOG_CONS
- val NDELAY = LOG_NDELAY
- val NOWAIT = LOG_NOWAIT
- val ODELAY = LOG_ODELAY
- val PID = LOG_PID
-end
-
-type facility = C.Int.t
-
-local
- open Facility
-in
- val AUTHPRIV = LOG_AUTH
- val CRON = LOG_CRON
- val DAEMON = LOG_DAEMON
- val KERN = LOG_KERN
- val LOCAL0 = LOG_LOCAL0
- val LOCAL1 = LOG_LOCAL1
- val LOCAL2 = LOG_LOCAL2
- val LOCAL3 = LOG_LOCAL3
- val LOCAL4 = LOG_LOCAL4
- val LOCAL5 = LOG_LOCAL5
- val LOCAL6 = LOG_LOCAL6
- val LOCAL7 = LOG_LOCAL7
- val LPR = LOG_LPR
- val MAIL = LOG_MAIL
- val NEWS = LOG_NEWS
-(* NOT STANDARD
- val SYSLOG = LOG_SYSLOG
-*)
- val USER = LOG_USER
- val UUCP = LOG_UUCP
-end
-
-type loglevel = C.Int.t
-
-local
- open Severity
-in
- val ALERT = LOG_ALERT
- val CRIT = LOG_CRIT
- val DEBUG = LOG_DEBUG
- val EMERG = LOG_EMERG
- val ERR = LOG_ERR
- val INFO = LOG_INFO
- val NOTICE = LOG_NOTICE
- val WARNING = LOG_WARNING
-end
-
-fun zt s = s ^ "\000"
-
-val openlog = fn (s, opt, fac) =>
- let
- val optf =
- Word32.toInt (foldl Word32.orb 0w0 (map Word32.fromInt opt))
- in
- openlog (NullString.fromString (zt s), optf, fac)
- end
-
-val closelog = fn () =>
- closelog ()
-
-val log = fn (lev, msg) =>
- syslog (lev, NullString.fromString (zt msg))
-
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,218 +0,0 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure NetHostDB:> NET_HOST_DB_EXTRA =
- struct
- structure Prim = PrimitiveFFI.NetHostDB
-
- (* network byte order (MSB) *)
- type pre_in_addr = Word8.word array
- type in_addr = Word8.word vector
-
- val preInAddrToWord8Array = fn a => a
- val inAddrToWord8Vector = fn v => v
-
- structure PW = PackWord32Big
- fun new_in_addr () =
- let
- val inAddrLen = Word32.toIntX Prim.inAddrSize
- val ia: pre_in_addr = Array.array (inAddrLen, 0wx0: Word8.word)
- fun finish () = Array.vector ia
- in
- (ia, finish)
- end
- fun inAddrToWord (ia: in_addr) =
- Word.fromLargeWord (PW.subVec (Word8Vector.fromPoly ia, 0))
- fun wordToInAddr w =
- let
- val (ia, finish) = new_in_addr ()
- val _ = PW.update (Word8Array.fromPoly ia, 0, Word.toLargeWord w)
- in
- finish ()
- end
- fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
- type addr_family = C.Int.t
-
- val intToAddrFamily = fn z => z
- val addrFamilyToInt = fn z => z
-
- datatype entry = T of {name: string,
- aliases: string list,
- addrType: addr_family,
- addrs: in_addr list}
-
- local
- fun make s (T r) = s r
- in
- val name = make #name
- val aliases = make #aliases
- val addrType = make #addrType
- val addrs = make #addrs
- end
- fun addr entry = hd (addrs entry)
-
- local
- fun get (b: bool): entry option =
- if b
- then let
- val name = COld.CS.toString (Prim.getEntryName ())
- val numAliases = Prim.getEntryAliasesNum ()
- fun fill (n, aliases) =
- if n < numAliases
- then let
- val alias =
- COld.CS.toString (Prim.getEntryAliasesN n)
- in
- fill (n + 1, alias::aliases)
- end
- else List.rev aliases
- val aliases = fill (0, [])
- val addrType = Prim.getEntryAddrType ()
- val length = Prim.getEntryLength ()
- val numAddrs = Prim.getEntryAddrsNum ()
- fun fill (n, addrs) =
- if n < numAddrs
- then let
- val addr = Word8Array.array (length, 0wx0)
- val _ =
- Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
- val addr =
- Word8Vector.toPoly (Word8Array.vector addr)
- in
- fill (n + 1, addr::addrs)
- end
- else List.rev addrs
- val addrs = fill (0, [])
- in
- SOME (T {name = name,
- aliases = aliases,
- addrType = addrType,
- addrs = addrs})
- end
- else NONE
- in
- fun getByAddr in_addr =
- get (Prim.getByAddress (in_addr, C.Socklen.fromInt (Vector.length in_addr)))
- fun getByName name =
- get (Prim.getByName (NullString.nullTerm name))
- end
-
- fun getHostName () =
- let
- val n = 128
- val buf = CharArray.array (n, #"\000")
- val () =
- Posix.Error.SysCall.simple
- (fn () => Prim.getHostName (CharArray.toPoly buf, C.Size.fromInt n))
- in
- case CharArray.findi (fn (_, c) => c = #"\000") buf of
- NONE => CharArray.vector buf
- | SOME (i, _) =>
- CharArraySlice.vector (CharArraySlice.slice (buf, 0, SOME i))
- end
-
- fun scan reader state =
- let
- fun scanW state =
- case reader state of
- SOME (#"0", state') =>
- (case reader state' of
- NONE => SOME (0w0, state')
- | SOME (c, state'') =>
- if Char.isDigit c
- then StringCvt.wdigits StringCvt.OCT reader state'
- else if c = #"x" orelse c = #"X"
- then StringCvt.wdigits StringCvt.HEX reader state''
- else SOME (0w0, state'))
- | _ => StringCvt.wdigits StringCvt.DEC reader state
- fun loop (n, state, acc) =
- if n <= 0
- then List.rev acc
- else let
- fun finish (w, state) =
- case reader state of
- SOME (#".", state') =>
- loop (n - 1, state', (w, state)::acc)
- | _ => List.rev ((w, state)::acc)
- in
- case scanW state of
- SOME (w, state') => finish (w, state')
- | NONE => List.rev acc
- end
- val l = loop (4, state, [])
- fun get1 w =
- (Word8.fromLarge (Word32.toLarge (Word32.andb (w, 0wxFF))),
- Word32.>>(w, 0w8))
- fun get2 w =
- let
- val (a,w) = get1 w
- val (b,w) = get1 w
- in (a,b,w)
- end
- fun get3 w =
- let
- val (a,b,w) = get2 w
- val (c,w) = get1 w
- in (a,b,c,w)
- end
- fun get4 w =
- let
- val (a,b,c,w) = get3 w
- val (d,w) = get1 w
- in (a,b,c,d,w)
- end
- fun try l =
- case l of
- [] => NONE
- | [(w, statew)] =>
- let
- val (d,c,b,a,w) = get4 w
- in
- if w = 0wx0
- then SOME (Vector.fromList [a,b,c,d], statew)
- else NONE
- end
- | [(x, statex), (w, statew)] =>
- let
- val (d,c,b,w) = get3 w
- val (a,x) = get1 x
- in
- if w = 0wx0 andalso x = 0wx0
- then SOME (Vector.fromList [a,b,c,d], statew)
- else try [(x, statex)]
- end
- | [(y, statey), (x, statex), (w, statew)] =>
- let
- val (d,c,w) = get2 w
- val (b,x) = get1 x
- val (a,y) = get1 y
- in
- if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0
- then SOME (Vector.fromList [a,b,c,d], statew)
- else try [(y, statey), (x, statex)]
- end
- | [(z, statez), (y, statey), (x, statex), (w, statew)] =>
- let
- val (d,w) = get1 w
- val (c,x) = get1 x
- val (b,y) = get1 y
- val (a,z) = get1 z
- in
- if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0 andalso z = 0wx0
- then SOME (Vector.fromList [a,b,c,d], statew)
- else try [(z, statez), (y, statey), (x, statex)]
- end
- | _ => NONE
- in
- try l
- end
-
- fun fromString s = StringCvt.scanString scan s
- fun toString in_addr =
- String.concatWith "."
- (Vector.foldr (fn (w,ss) => (Word8.fmt StringCvt.DEC w)::ss) [] in_addr)
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,203 +0,0 @@
-signature SOCKET =
- sig
- type active
- type dgram
- type in_flags = {peek: bool, oob: bool}
- type out_flags = {don't_route: bool, oob: bool}
- type passive
- datatype shutdown_mode =
- NO_RECVS
- | NO_SENDS
- | NO_RECVS_OR_SENDS
- type ('af,'sock_type) sock
- type 'af sock_addr
- type sock_desc
- type 'mode stream
-
- structure AF:
- sig
- type addr_family = NetHostDB.addr_family
-
- val fromString: string -> addr_family option
- val list: unit -> (string * addr_family) list
- val toString: addr_family -> string
- end
-
- structure SOCK:
- sig
- eqtype sock_type
-
- val dgram: sock_type
- val fromString: string -> sock_type option
- val list: unit -> (string * sock_type) list
- val stream: sock_type
- val toString: sock_type -> string
- end
-
- structure Ctl:
- sig
- val getATMARK: ('af, active stream) sock -> bool
- val getBROADCAST: ('af, 'sock_type) sock -> bool
- val getDEBUG: ('af, 'sock_type) sock -> bool
- val getDONTROUTE: ('af, 'sock_type) sock -> bool
- val getERROR: ('af, 'sock_type) sock -> bool
- val getKEEPALIVE: ('af, 'sock_type) sock -> bool
- val getLINGER: ('af, 'sock_type) sock -> Time.time option
- val getNREAD: ('af, 'sock_type) sock -> int
- val getOOBINLINE: ('af, 'sock_type) sock -> bool
- val getPeerName: ('af, 'sock_type) sock -> 'af sock_addr
- val getRCVBUF: ('af, 'sock_type) sock -> int
- val getREUSEADDR: ('af, 'sock_type) sock -> bool
- val getSNDBUF: ('af, 'sock_type) sock -> int
- val getSockName: ('af, 'sock_type) sock -> 'af sock_addr
- val getTYPE: ('af, 'sock_type) sock -> SOCK.sock_type
- val setBROADCAST: ('af, 'sock_type) sock * bool -> unit
- val setDEBUG: ('af, 'sock_type) sock * bool -> unit
- val setDONTROUTE: ('af, 'sock_type) sock * bool -> unit
- val setKEEPALIVE: ('af, 'sock_type) sock * bool -> unit
- val setLINGER: ('af, 'sock_type) sock * Time.time option -> unit
- val setOOBINLINE: ('af, 'sock_type) sock * bool -> unit
- val setRCVBUF: ('af, 'sock_type) sock * int -> unit
- val setREUSEADDR: ('af, 'sock_type) sock * bool -> unit
- val setSNDBUF: ('af, 'sock_type) sock * int -> unit
- end
-
- val accept: ('af, passive stream) sock -> (('af, active stream) sock
- * 'af sock_addr)
- val acceptNB: ('af, passive stream) sock -> (('af, active stream) sock
- * 'af sock_addr) option
- val bind: ('af, 'sock_type) sock * 'af sock_addr -> unit
- val close: ('af, 'sock_type) sock -> unit
- val connect: ('af, 'sock_type) sock * 'af sock_addr -> unit
- val connectNB: ('af, 'sock_type) sock * 'af sock_addr -> bool
- val familyOfAddr: 'af sock_addr -> AF.addr_family
- val ioDesc: ('af, 'sock_type) sock -> OS.IO.iodesc
- val listen: ('af, passive stream) sock * int -> unit
- val recvArr: ('af, active stream) sock * Word8ArraySlice.slice -> int
- val recvArr': (('af, active stream) sock
- * Word8ArraySlice.slice
- * in_flags) -> int
- val recvArrFrom: (('af, dgram) sock * Word8ArraySlice.slice
- -> int * 'af sock_addr)
- val recvArrFrom': (('af, dgram) sock * Word8ArraySlice.slice * in_flags
- -> int * 'af sock_addr)
- val recvArrFromNB: (('af, dgram) sock * Word8ArraySlice.slice
- -> (int * 'af sock_addr) option)
- val recvArrFromNB': (('af, dgram) sock * Word8ArraySlice.slice * in_flags
- -> (int * 'af sock_addr) option)
- val recvArrNB: (('af, active stream) sock
- * Word8ArraySlice.slice) -> int option
- val recvArrNB': (('af, active stream) sock
- * Word8ArraySlice.slice
- * in_flags) -> int option
- val recvVec: ('af, active stream) sock * int -> Word8Vector.vector
- val recvVec': (('af, active stream) sock * int * in_flags
- -> Word8Vector.vector)
- val recvVecFrom: (('af, dgram) sock * int
- -> Word8Vector.vector * 'af sock_addr)
- val recvVecFrom': (('af, dgram) sock * int * in_flags
- -> Word8Vector.vector * 'af sock_addr)
- val recvVecFromNB: (('af, dgram) sock * int
- -> (Word8Vector.vector * 'af sock_addr) option)
- val recvVecFromNB': (('af, dgram) sock * int * in_flags
- -> (Word8Vector.vector * 'af sock_addr) option)
- val recvVecNB: ('af, active stream) sock * int -> Word8Vector.vector option
- val recvVecNB': (('af, active stream) sock * int * in_flags
- -> Word8Vector.vector option)
- val sameAddr: 'af sock_addr * 'af sock_addr -> bool
- val sameDesc: sock_desc * sock_desc -> bool
- val select: {exs: sock_desc list,
- rds: sock_desc list,
- timeout: Time.time option,
- wrs: sock_desc list} -> {exs: sock_desc list,
- rds: sock_desc list,
- wrs: sock_desc list}
- val sendArr: ('af, active stream) sock * Word8ArraySlice.slice -> int
- val sendArr': (('af, active stream) sock
- * Word8ArraySlice.slice
- * out_flags) -> int
- val sendArrNB: (('af, active stream) sock * Word8ArraySlice.slice
- -> int option)
- val sendArrNB': (('af, active stream) sock
- * Word8ArraySlice.slice
- * out_flags) -> int option
- val sendArrTo: (('af, dgram) sock
- * 'af sock_addr
- * Word8ArraySlice.slice) -> unit
- val sendArrTo': (('af, dgram) sock
- * 'af sock_addr
- * Word8ArraySlice.slice
- * out_flags) -> unit
- val sendArrToNB: (('af, dgram) sock
- * 'af sock_addr
- * Word8ArraySlice.slice) -> bool
- val sendArrToNB': (('af, dgram) sock
- * 'af sock_addr
- * Word8ArraySlice.slice
- * out_flags) -> bool
- val sendVec: ('af, active stream) sock * Word8VectorSlice.slice -> int
- val sendVec': (('af, active stream) sock
- * Word8VectorSlice.slice
- * out_flags) -> int
- val sendVecNB: (('af, active stream) sock
- * Word8VectorSlice.slice) -> int option
- val sendVecNB': (('af, active stream) sock
- * Word8VectorSlice.slice
- * out_flags) -> int option
- val sendVecTo: (('af, dgram) sock
- * 'af sock_addr
- * Word8VectorSlice.slice) -> unit
- val sendVecTo': (('af, dgram) sock
- * 'af sock_addr
- * Word8VectorSlice.slice
- * out_flags) -> unit
- val sendVecToNB: (('af, dgram) sock
- * 'af sock_addr
- * Word8VectorSlice.slice) -> bool
- val sendVecToNB': (('af, dgram) sock
- * 'af sock_addr
- * Word8VectorSlice.slice
- * out_flags) -> bool
- val shutdown: ('af, 'mode stream) sock * shutdown_mode -> unit
- val sockDesc: ('af, 'sock_type) sock -> sock_desc
- end
-
-signature SOCKET_EXTRA =
- sig
- include SOCKET
- val sockToWord: ('af, 'sock_type) sock -> SysWord.word
- val wordToSock: SysWord.word -> ('af, 'sock_type) sock
- val sockToFD: ('af, 'sock_type) sock -> Posix.FileSys.file_desc
- val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) sock
- type pre_sock_addr
- val unpackSockAddr: 'af sock_addr -> Word8Vector.vector
- val new_sock_addr: unit -> (pre_sock_addr * C.Socklen.t ref * (unit -> 'af sock_addr))
-
- structure CtlExtra:
- sig
- type level = int
- type optname = int
- type request = int
-
-(* val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
-(* val setSockOptWord:
- * level * optname -> ('af, 'sock_type) sock * word -> unit
- *)
- val getERROR:
- ('af, 'sock_type) sock
- -> (string * Posix.Error.syserror option) option
- val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
- val setSockOptInt:
- level * optname -> ('af, 'sock_type) sock * int -> unit
- val getSockOptBool: level * optname -> ('af, 'sock_type) sock -> bool
- val setSockOptBool:
- level * optname -> ('af, 'sock_type) sock * bool -> unit
-
-(* val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
-(* val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
- val getIOCtlInt: request -> ('af, 'sock_type) sock -> int
-(* val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
- val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
-(* val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,585 +0,0 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure Socket:> SOCKET_EXTRA
- where type SOCK.sock_type = C.Int.t
- where type pre_sock_addr = Word8.word array
-=
-struct
-
-structure Prim = PrimitiveFFI.Socket
-structure Error = Posix.Error
-structure Syscall = Error.SysCall
-structure FileSys = Posix.FileSys
-
-type sock = C.Sock.t
-val sockToWord = SysWord.fromInt o C.Sock.toInt
-val wordToSock = C.Sock.fromInt o SysWord.toInt
-fun sockToFD sock = FileSys.wordToFD (sockToWord sock)
-fun fdToSock fd = wordToSock (FileSys.fdToWord fd)
-
-type pre_sock_addr = Word8.word array
-datatype sock_addr = SA of Word8.word vector
-fun unpackSockAddr (SA sa) = Word8Vector.fromPoly sa
-fun new_sock_addr (): (pre_sock_addr * C.Socklen.t ref * (unit -> sock_addr)) =
- let
- val salen = C.Size.toInt Prim.sockAddrStorageLen
- val sa = Array.array (salen, 0wx0)
- val salenRef = ref (C.Socklen.fromInt salen)
- fun finish () =
- SA (ArraySlice.vector (ArraySlice.slice
- (sa, 0, SOME (C.Socklen.toInt (!salenRef)))))
- in
- (sa, salenRef, finish)
- end
-datatype dgram = DGRAM (* phantom *)
-datatype stream = MODE (* phantom *)
-datatype passive = PASSIVE (* phantom *)
-datatype active = ACTIVE (* phantom *)
-
-structure AF =
- struct
- type addr_family = NetHostDB.addr_family
- val i2a = NetHostDB.intToAddrFamily
- val names = [
- ("UNIX", i2a Prim.AF.UNIX),
- ("INET", i2a Prim.AF.INET),
- ("INET6", i2a Prim.AF.INET6),
- ("UNSPEC", i2a Prim.AF.UNSPEC)
- ]
- fun list () = names
- fun toString af' =
- case List.find (fn (_, af) => af = af') names of
- SOME (name, _) => name
- | NONE => raise (Fail "Internal error: bogus addr_family")
- fun fromString name' =
- case List.find (fn (name, _) => name = name') names of
- SOME (_, af) => SOME af
- | NONE => NONE
- end
-
-structure SOCK =
- struct
- type sock_type = C.Int.t
- val stream = Prim.SOCK.STREAM
- val dgram = Prim.SOCK.DGRAM
- val names = [
- ("STREAM", stream),
- ("DGRAM", dgram)
- ]
- fun list () = names
- fun toString st' =
- case List.find (fn (_, st) => st = st') names of
- SOME (name, _) => name
- | NONE => raise (Fail "Internal error: bogus sock_type")
- fun fromString name' =
- case List.find (fn (name, _) => name = name') names of
- SOME (_, st) => SOME st
- | NONE => NONE
- end
-
-structure CtlExtra =
- struct
- type level = C.Int.t
- type optname = C.Int.t
- type request = C.Int.t
-
- (* host byte order *)
- structure PW = PackWord32Host
-
- val wordLen = PW.bytesPerElem
- fun unmarshalWord (wa, _, s): word =
- Word.fromLargeWord (PW.subArr (wa, s))
- val intLen: int = wordLen
- fun unmarshalInt (wa, l, s): int =
- Word.toIntX (unmarshalWord (wa, l, s))
- val boolLen: int = intLen
- fun unmarshalBool (wa, l, s): bool =
- if (unmarshalInt (wa, l, s)) = 0 then false else true
- val timeOptLen: int = boolLen + intLen
- fun unmarshalTimeOpt (wa, l, s): Time.time option =
- if unmarshalBool (wa, l, s)
- then SOME (Time.fromSeconds
- (LargeInt.fromInt
- (unmarshalInt (wa, l, s + 1))))
- else NONE
-
- fun marshalWord (w, wa, s) =
- PW.update (wa, s, Word.toLargeWord w)
-
- fun marshalInt (i, wa, s) =
- marshalWord (Word.fromInt i, wa, s)
-
- fun marshalBool (b, wa, s) =
- marshalInt (if b then 1 else 0, wa, s)
-
- fun marshalTimeOpt (t, wa, s) =
- case t of
- NONE => (marshalBool (false, wa, s)
- ; marshalInt (0, wa, s + 1))
- | SOME t =>
- (marshalBool (true, wa, s)
- ; marshalWord (Word.fromLargeInt (Time.toSeconds t)
- handle Overflow => Error.raiseSys Error.inval,
- wa, s + 1))
-
- local
- fun make (optlen: int,
- write: 'a * Word8Array.array * int -> unit,
- unmarshal: Word8Array.array * int * int -> 'a) =
- let
- fun marshal (x: 'a): Word8Vector.vector =
- let
- val wa = Word8Array.array (optlen, 0wx0)
- in
- write (x, wa, 0)
- ; Word8Array.vector wa
- end
- fun getSockOpt (level: level, optname: optname) s =
- let
- val optval = Word8Array.array (optlen, 0wx0)
- val optlen = ref (C.Socklen.fromInt optlen)
- in
- Syscall.simple
- (fn () =>
- Prim.Ctl.getSockOpt (s, level, optname,
- Word8Array.toPoly optval,
- optlen))
- ; unmarshal (optval, C.Socklen.toInt (!optlen), 0)
- end
- fun setSockOpt (level: level, optname: optname) (s, optval) =
- let
- val optval = marshal optval
- val optlen = Word8Vector.length optval
- in
- Syscall.simple
- (fn () =>
- Prim.Ctl.setSockOpt (s, level, optname,
- Word8Vector.toPoly optval,
- C.Socklen.fromInt optlen))
- end
- fun getIOCtl (request: request) s : 'a =
- let
- val optval = Word8Array.array (optlen, 0wx0)
- in
- Syscall.simple
- (fn () =>
- Prim.Ctl.getIOCtl
- (s, request, Word8Array.toPoly optval))
- ; unmarshal (optval, optlen, 0)
- end
- fun setIOCtl (request: request) (s, optval: 'a): unit =
- let
- val optval = marshal optval
- in
- Syscall.simple
- (fn () =>
- Prim.Ctl.setIOCtl
- (s, request, Word8Vector.toPoly optval))
- end
- in
- (getSockOpt, getIOCtl, setSockOpt, setIOCtl)
- end
- in
- val (getSockOptInt, getIOCtlInt, setSockOptInt, _) =
- make (intLen, marshalInt, unmarshalInt)
- val (getSockOptBool, getIOCtlBool, setSockOptBool, _) =
- make (boolLen, marshalBool, unmarshalBool)
- val (getSockOptTimeOpt, _, setSockOptTimeOpt, _) =
- make (timeOptLen, marshalTimeOpt, unmarshalTimeOpt)
- end
-
- val getDEBUG = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DEBUG)
- val setDEBUG = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DEBUG)
- val getREUSEADDR = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_REUSEADDR)
- val setREUSEADDR = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_REUSEADDR)
- val getKEEPALIVE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_KEEPALIVE)
- val setKEEPALIVE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_KEEPALIVE)
- val getDONTROUTE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
- val setDONTROUTE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
- val getBROADCAST = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
- val getLINGER = getSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
- val setLINGER = setSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
- val setBROADCAST = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
- val getOOBINLINE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
- val setOOBINLINE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
- val getSNDBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
- val setSNDBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
- val getRCVBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
- val setRCVBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
- fun getTYPE s = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_TYPE) s
- fun getERROR s =
- let
- val se = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_ERROR) s
- in
- if 0 = se
- then NONE
- else SOME (Posix.Error.errorMsg se, SOME se)
- end handle Error.SysErr z => SOME z
- local
- fun getName (s, f: sock * pre_sock_addr * C.Socklen.t ref -> int) =
- let
- val (sa, salen, finish) = new_sock_addr ()
- val () = Syscall.simple (fn () => f (s, sa, salen))
- in
- finish ()
- end
- in
- fun getPeerName s = getName (s, Prim.Ctl.getPeerName)
- fun getSockName s = getName (s, Prim.Ctl.getSockName)
- end
- val getNREAD = getIOCtlInt Prim.Ctl.FIONREAD
- val getATMARK = getIOCtlBool Prim.Ctl.SIOCATMARK
- end
-
-structure Ctl =
- struct
- open CtlExtra
-
- val getERROR = isSome o CtlExtra.getERROR
- end
-
-fun sameAddr (SA sa1, SA sa2) = sa1 = sa2
-
-fun familyOfAddr (SA sa) = NetHostDB.intToAddrFamily (Prim.familyOfAddr sa)
-
-fun bind (s, SA sa) =
- Syscall.simple (fn () => Prim.bind (s, sa, C.Socklen.fromInt (Vector.length sa)))
-
-fun listen (s, n) =
- Syscall.simple (fn () => Prim.listen (s, n))
-
-fun nonBlock' ({restart: bool},
- f : unit -> int, post : int -> 'a, again, no : 'a) =
- Syscall.syscallErr
- ({clear = false, restart = restart},
- fn () => let val res = f ()
- in
- {return = res,
- post = fn () => post res,
- handlers = [(again, fn () => no)]}
- end)
-
-fun nonBlock (f, post, no) =
- nonBlock' ({restart = true}, f, post, Error.again, no)
-
-local
- structure PIO = PrimitiveFFI.Posix.IO
-in
- fun withNonBlock (s, f: unit -> 'a) =
- let
- val fd = s
- val flags =
- Syscall.simpleResultRestart (fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
- val _ =
- Syscall.simpleResultRestart
- (fn () =>
- PIO.fcntl3 (fd, PIO.F_SETFL,
- Word.toIntX
- (Word.orb (Word.fromInt flags,
- SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.NONBLOCK))))
- in
- DynamicWind.wind
- (f, fn () =>
- Syscall.simple (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
- end
-end
-
-fun connect (s, SA sa) =
- Syscall.simple (fn () => Prim.connect (s, sa, C.Socklen.fromInt (Vector.length sa)))
-
-fun connectNB (s, SA sa) =
- nonBlock'
- ({restart = false}, fn () =>
- withNonBlock (s, fn () => Prim.connect (s, sa, C.Socklen.fromInt (Vector.length sa))),
- fn _ => true,
- Error.inprogress, false)
-
-fun accept s =
- let
- val (sa, salen, finish) = new_sock_addr ()
- val s = Syscall.simpleResultRestart (fn () => Prim.accept (s, sa, salen))
- in
- (s, finish ())
- end
-
-fun acceptNB s =
- let
- val (sa, salen, finish) = new_sock_addr ()
- in
- nonBlock
- (fn () => withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
- fn s => SOME (s, finish ()),
- NONE)
- end
-
-fun close s = Syscall.simple (fn () => Prim.close s)
-
-datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS
-
-fun shutdownModeToHow m =
- case m of
- NO_RECVS => Prim.SHUT_RD
- | NO_SENDS => Prim.SHUT_WR
- | NO_RECVS_OR_SENDS => Prim.SHUT_RDWR
-
-fun shutdown (s, m) =
- let val m = shutdownModeToHow m
- in Syscall.simple (fn () => Prim.shutdown (s, m))
- end
-
-type sock_desc = OS.IO.iodesc
-
-fun sockDesc sock = FileSys.fdToIOD (sockToFD sock)
-
-fun sameDesc (desc1, desc2) =
- OS.IO.compare (desc1, desc2) = EQUAL
-
-fun select {rds: sock_desc list,
- wrs: sock_desc list,
- exs: sock_desc list,
- timeout: Time.time option} =
- let
- fun mk poll (sd,pds) =
- let
- val pd = Option.valOf (OS.IO.pollDesc sd)
- val pd = poll pd
- in
- pd::pds
- end
- val pds =
- (List.foldr (mk OS.IO.pollIn)
- (List.foldr (mk OS.IO.pollOut)
- (List.foldr (mk OS.IO.pollPri)
- [] exs) wrs) rds)
- val pis = OS.IO.poll (pds, timeout)
- val {rds, wrs, exs} =
- List.foldr
- (fn (pi,{rds,wrs,exs}) =>
- let
- fun mk (is,l) =
- if is pi
- then (OS.IO.pollToIODesc (OS.IO.infoToPollDesc pi))::l
- else l
- in
- {rds = mk (OS.IO.isIn, rds),
- wrs = mk (OS.IO.isOut, wrs),
- exs = mk (OS.IO.isPri, exs)}
- end)
- {rds = [], wrs = [], exs = []}
- pis
- in
- {rds = rds, wrs = wrs, exs = exs}
- end
-
-val ioDesc = sockDesc
-
-type out_flags = {don't_route: bool, oob: bool}
-
-fun mk_out_flags {don't_route, oob} =
- Word.orb (if don't_route then Word.fromInt Prim.MSG_DONTROUTE else 0wx0,
- Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
- 0wx0))
-val no_out_flags = {don't_route = false, oob = false}
-
-local
- fun make (base, toPoly, primSend, primSendTo) =
- let
- val base = fn sl => let val (buf, i, sz) = base sl
- in (toPoly buf, i, sz)
- end
- fun send' (s, sl, out_flags) =
- let
- val (buf, i, sz) = base sl
- in
- Syscall.simpleResultRestart
- (fn () => primSend (s, buf, i, C.Size.fromInt sz,
- Word.toInt (mk_out_flags out_flags)))
- end
- fun send (sock, buf) = send' (sock, buf, no_out_flags)
- fun sendNB' (s, sl, out_flags) =
- let
- val (buf, i, sz) = base sl
- in
- nonBlock
- (fn () =>
- primSend (s, buf, i, C.Size.fromInt sz,
- Word.toInt (
- Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
- mk_out_flags out_flags))),
- SOME,
- NONE)
- end
- fun sendNB (sock, sl) = sendNB' (sock, sl, no_out_flags)
- fun sendTo' (s, SA sa, sl, out_flags) =
- let
- val (buf, i, sz) = base sl
- in
- Syscall.simpleRestart
- (fn () =>
- primSendTo (s, buf, i, C.Size.fromInt sz,
- Word.toInt (mk_out_flags out_flags),
- sa, C.Socklen.fromInt (Vector.length sa)))
- end
- fun sendTo (sock, sock_addr, sl) =
- sendTo' (sock, sock_addr, sl, no_out_flags)
- fun sendToNB' (s, SA sa, sl, out_flags) =
- let
- val (buf, i, sz) = base sl
- in
- nonBlock
- (fn () =>
- primSendTo (s, buf, i, C.Size.fromInt sz,
- Word.toInt (
- Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
- mk_out_flags out_flags)),
- sa, C.Socklen.fromInt (Vector.length sa)),
- fn _ => true,
- false)
- end
- fun sendToNB (sock, sa, sl) =
- sendToNB' (sock, sa, sl, no_out_flags)
- in
- (send, send', sendNB, sendNB', sendTo, sendTo', sendToNB, sendToNB')
- end
-in
- val (sendArr, sendArr', sendArrNB, sendArrNB',
- sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') =
- make (Word8ArraySlice.base, Word8Array.toPoly,
- Prim.sendArr, Prim.sendArrTo)
- val (sendVec, sendVec', sendVecNB, sendVecNB',
- sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') =
- make (Word8VectorSlice.base, Word8Vector.toPoly,
- Prim.sendVec, Prim.sendVecTo)
-end
-
-type in_flags = {peek: bool, oob: bool}
-
-val no_in_flags = {peek = false, oob = false}
-
-fun mk_in_flags {peek, oob} =
- Word.orb (if peek then Word.fromInt Prim.MSG_PEEK else 0wx0,
- Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
- 0wx0))
-
-fun recvArr' (s, sl, in_flags) =
- let
- val (buf, i, sz) = Word8ArraySlice.base sl
- in
- Syscall.simpleResultRestart
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
- Word.toInt (mk_in_flags in_flags)))
- end
-
-fun getVec (a, n, bytesRead) =
- if n = bytesRead
- then Word8Vector.fromArray a
- else Word8ArraySlice.vector (Word8ArraySlice.slice (a, 0, SOME bytesRead))
-
-fun recvVec' (sock, n, in_flags) =
- let
- val a = Word8Array.rawArray n
- val bytesRead =
- recvArr' (sock, Word8ArraySlice.full a, in_flags)
- in
- getVec (a, n, bytesRead)
- end
-
-fun recvArr (sock, sl) = recvArr' (sock, sl, no_in_flags)
-
-fun recvVec (sock, n) = recvVec' (sock, n, no_in_flags)
-
-fun recvArrFrom' (s, sl, in_flags) =
- let
- val (buf, i, sz) = Word8ArraySlice.base sl
- val (sa, salen, finish) = new_sock_addr ()
- val n =
- Syscall.simpleResultRestart
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
- Word.toInt (mk_in_flags in_flags),
- sa, salen))
- in
- (n, finish ())
- end
-
-fun recvVecFrom' (sock, n, in_flags) =
- let
- val a = Word8Array.fromPoly (Primitive.Array.array n)
- val (bytesRead, sock_addr) =
- recvArrFrom' (sock, Word8ArraySlice.full a, in_flags)
- in
- (getVec (a, n, bytesRead), sock_addr)
- end
-
-fun recvArrFrom (sock, sl) = recvArrFrom' (sock, sl, no_in_flags)
-
-fun recvVecFrom (sock, n) = recvVecFrom' (sock, n, no_in_flags)
-
-fun mk_in_flagsNB z = Word.orb (mk_in_flags z, Word.fromInt Prim.MSG_DONTWAIT)
-
-fun recvArrNB' (s, sl, in_flags) =
- let
- val (buf, i, sz) = Word8ArraySlice.base sl
- in
- nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
- Word.toInt (mk_in_flagsNB in_flags)),
- SOME,
- NONE)
- end
-
-fun recvVecNB' (s, n, in_flags) =
- let
- val a = Word8Array.rawArray n
- in
- nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly a, 0, C.Size.fromInt n,
- Word.toInt (mk_in_flagsNB in_flags)),
- fn bytesRead => SOME (getVec (a, n, bytesRead)),
- NONE)
- end
-
-fun recvArrNB (sock, sl) = recvArrNB' (sock, sl, no_in_flags)
-
-fun recvVecNB (sock, n) = recvVecNB' (sock, n, no_in_flags)
-
-fun recvArrFromNB' (s, sl, in_flags) =
- let
- val (buf, i, sz) = Word8ArraySlice.base sl
- val (sa, salen, finish) = new_sock_addr ()
- in
- nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
- Word.toInt (mk_in_flagsNB in_flags), sa, salen),
- fn n => SOME (n, finish ()),
- NONE)
- end
-
-fun recvVecFromNB' (s, n, in_flags) =
- let
- val a = Word8Array.fromPoly (Primitive.Array.array n)
- val (sa, salen, finish) = new_sock_addr ()
- in
- nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C.Size.fromInt n,
- Word.toInt (mk_in_flagsNB in_flags), sa, salen),
- fn bytesRead => SOME (getVec (a, n, bytesRead), finish ()),
- NONE)
- end
-
-fun recvArrFromNB (sock, sl) = recvArrFromNB' (sock, sl, no_in_flags)
-
-fun recvVecFromNB (sock, n) = recvVecFromNB' (sock, n, no_in_flags)
-
-(* Phantom type. *)
-type ('af, 'sock_type) sock = sock
-
-type 'af sock_addr = sock_addr
-
-type 'mode stream = stream
-
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,52 +0,0 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure UnixSock : UNIX_SOCK =
- struct
- structure Prim = PrimitiveFFI.Socket.UnixSock
-
- datatype unix = UNIX
- type 'sock_type sock = (unix, 'sock_type) Socket.sock
- type 'mode stream_sock = 'mode Socket.stream sock
- type dgram_sock = Socket.dgram sock
- type sock_addr = unix Socket.sock_addr
- val unixAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.UNIX
-
- fun toAddr s =
- let
- val (sa, salen, finish) = Socket.new_sock_addr ()
- val _ = Prim.toAddr (NullString.nullTerm s,
- C.Size.fromInt (String.size s),
- sa, salen)
- in
- finish ()
- end
-
- fun fromAddr sa =
- let
- val sa = Socket.unpackSockAddr sa
- val sa = Word8Vector.toPoly sa
- val len = Prim.pathLen sa
- val a = CharArray.array (C.Size.toInt len, #"\000")
- val _ = Prim.fromAddr (sa, CharArray.toPoly a, len)
- in
- CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME (C.Size.toInt len)))
- end
-
- structure Strm =
- struct
- fun socket () = GenericSock.socket (unixAF, Socket.SOCK.stream)
- fun socketPair () =
- GenericSock.socketPair (unixAF, Socket.SOCK.stream)
- end
- structure DGrm =
- struct
- fun socket () = GenericSock.socket (unixAF, Socket.SOCK.dgram)
- fun socketPair () =
- GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,310 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixError: POSIX_ERROR_EXTRA =
- struct
- structure Prim = PrimitiveFFI.Posix.Error
- open Prim
-
- type syserror = C.Int.t
-
- val acces = EACCES
- val addrinuse = EADDRINUSE
- val addrnotavail = EADDRNOTAVAIL
- val afnosupport = EAFNOSUPPORT
- val again = EAGAIN
- val already = EALREADY
- val badf = EBADF
- val badmsg = EBADMSG
- val busy = EBUSY
- val canceled = ECANCELED
- val child = ECHILD
- val connaborted = ECONNABORTED
- val connrefused = ECONNREFUSED
- val connreset = ECONNRESET
- val deadlk = EDEADLK
- val destaddrreq = EDESTADDRREQ
- val dom = EDOM
- val dquot = EDQUOT
- val exist = EEXIST
- val fault = EFAULT
- val fbig = EFBIG
- val hostunreach = EHOSTUNREACH
- val idrm = EIDRM
- val ilseq = EILSEQ
- val inprogress = EINPROGRESS
- val intr = EINTR
- val inval = EINVAL
- val io = EIO
- val isconn = EISCONN
- val isdir = EISDIR
- val loop = ELOOP
- val mfile = EMFILE
- val mlink = EMLINK
- val msgsize = EMSGSIZE
- val multihop = EMULTIHOP
- val nametoolong = ENAMETOOLONG
- val netdown = ENETDOWN
- val netreset = ENETRESET
- val netunreach = ENETUNREACH
- val nfile = ENFILE
- val nobufs = ENOBUFS
- val nodata = ENODATA
- val nodev = ENODEV
- val noent = ENOENT
- val noexec = ENOEXEC
- val nolck = ENOLCK
- val nolink = ENOLINK
- val nomem = ENOMEM
- val nomsg = ENOMSG
- val noprotoopt = ENOPROTOOPT
- val nospc = ENOSPC
- val nosr = ENOSR
- val nostr = ENOSTR
- val nosys = ENOSYS
- val notconn = ENOTCONN
- val notdir = ENOTDIR
- val notempty = ENOTEMPTY
- val notsock = ENOTSOCK
- val notsup = ENOTSUP
- val notty = ENOTTY
- val nxio = ENXIO
- val opnotsupp = EOPNOTSUPP
- val overflow = EOVERFLOW
- val perm = EPERM
- val pipe = EPIPE
- val proto = EPROTO
- val protonosupport = EPROTONOSUPPORT
- val prototype = EPROTOTYPE
- val range = ERANGE
- val rofs = EROFS
- val spipe = ESPIPE
- val srch = ESRCH
- val stale = ESTALE
- val time = ETIME
- val timedout = ETIMEDOUT
- val toobig = E2BIG
- val txtbsy = ETXTBSY
- val wouldblock = EWOULDBLOCK
- val xdev = EXDEV
-
- val errorNames =
- [
- (acces,"acces"),
- (addrinuse,"addrinuse"),
- (addrnotavail,"addrnotavail"),
- (afnosupport,"afnosupport"),
- (again,"again"),
- (already,"already"),
- (badf,"badf"),
- (badmsg,"badmsg"),
- (busy,"busy"),
- (canceled,"canceled"),
- (child,"child"),
- (connaborted,"connaborted"),
- (connrefused,"connrefused"),
- (connreset,"connreset"),
- (deadlk,"deadlk"),
- (destaddrreq,"destaddrreq"),
- (dom,"dom"),
- (dquot,"dquot"),
- (exist,"exist"),
- (fault,"fault"),
- (fbig,"fbig"),
- (hostunreach,"hostunreach"),
- (idrm,"idrm"),
- (ilseq,"ilseq"),
- (inprogress,"inprogress"),
- (intr,"intr"),
- (inval,"inval"),
- (io,"io"),
- (isconn,"isconn"),
- (isdir,"isdir"),
- (loop,"loop"),
- (mfile,"mfile"),
- (mlink,"mlink"),
- (msgsize,"msgsize"),
- (multihop,"multihop"),
- (nametoolong,"nametoolong"),
- (netdown,"netdown"),
- (netreset,"netreset"),
- (netunreach,"netunreach"),
- (nfile,"nfile"),
- (nobufs,"nobufs"),
- (nodata,"nodata"),
- (nodev,"nodev"),
- (noent,"noent"),
- (noexec,"noexec"),
- (nolck,"nolck"),
- (nolink,"nolink"),
- (nomem,"nomem"),
- (nomsg,"nomsg"),
- (noprotoopt,"noprotoopt"),
- (nospc,"nospc"),
- (nosr,"nosr"),
- (nostr,"nostr"),
- (nosys,"nosys"),
- (notconn,"notconn"),
- (notdir,"notdir"),
- (notempty,"notempty"),
- (notsock,"notsock"),
- (notsup,"notsup"),
- (notty,"notty"),
- (nxio,"nxio"),
- (opnotsupp,"opnotsupp"),
- (overflow,"overflow"),
- (perm,"perm"),
- (pipe,"pipe"),
- (proto,"proto"),
- (protonosupport,"protonosupport"),
- (prototype,"prototype"),
- (range,"range"),
- (rofs,"rofs"),
- (spipe,"spipe"),
- (srch,"srch"),
- (stale,"stale"),
- (time,"time"),
- (timedout,"timedout"),
- (toobig,"toobig"),
- (txtbsy,"txtbsy"),
- (wouldblock,"wouldblock"),
- (xdev,"xdev")
- ]
-
- exception SysErr of string * syserror option
-
- val toWord = SysWord.fromInt
- val fromWord = SysWord.toInt
-
- val cleared : syserror = 0
-
- fun errorName n =
- case List.find (fn (m, _) => n = m) errorNames of
- NONE => "<UNKNOWN>"
- | SOME (_, s) => s
-
- val _ =
- General.addExnMessager
- (fn e =>
- case e of
- SysErr (s, eo) =>
- SOME (concat ["SysErr: ", s,
- case eo of
- NONE => ""
- | SOME e => concat [" [", errorName e, "]"]])
- | _ => NONE)
-
- fun syserror s =
- case List.find (fn (_, s') => s = s') errorNames of
- NONE => NONE
- | SOME (n, _) => SOME n
-
- fun errorMsg (n: int) =
- let
- val cs = strError n
- in
- if cs = Primitive.Pointer.null
- then "Unknown error"
- else COld.CS.toString cs
- end
-
- fun raiseSys n = raise SysErr (errorMsg n, SOME n)
-
- structure SysCall =
- struct
- structure Thread = Primitive.Thread
-
- val blocker: (unit -> (unit -> unit)) ref =
- ref (fn () => (fn () => ()))
- (* ref (fn () => raise Fail "blocker not installed") *)
- val restartFlag = ref true
-
- val syscallErr: {clear: bool, restart: bool} *
- (unit -> {return: int,
- post: unit -> 'a,
- handlers: (syserror * (unit -> 'a)) list}) -> 'a =
- fn ({clear, restart}, f) =>
- let
- fun call (err: {errno: syserror,
- handlers: (syserror * (unit -> 'a)) list} -> 'a): 'a =
- let
- val () = Thread.atomicBegin ()
- val () = if clear then clearErrno () else ()
- val {return, post, handlers} =
- f () handle exn => (Thread.atomicEnd (); raise exn)
- in
- if ~1 = return
- then
- (* Must getErrno () in the critical section. *)
- let
- val e = getErrno ()
- val () = Thread.atomicEnd ()
- in
- err {errno = e, handlers = handlers}
- end
- else DynamicWind.wind (post, Thread.atomicEnd)
- end
- fun err {default: unit -> 'a,
- errno: syserror,
- handlers: (syserror * (unit -> 'a)) list}: 'a =
- case List.find (fn (e',_) => errno = e') handlers of
- NONE => default ()
- | SOME (_, handler) => handler ()
- fun errBlocked {errno: syserror,
- handlers: (syserror * (unit -> 'a)) list}: 'a =
- err {default = fn () => raiseSys errno,
- errno = errno, handlers = handlers}
- fun errUnblocked
- {errno: syserror,
- handlers: (syserror * (unit -> 'a)) list}: 'a =
- err {default = fn () =>
- if restart andalso errno = intr andalso !restartFlag
- then if Thread.canHandle () = 0
- then call errUnblocked
- else let val finish = !blocker ()
- in
- DynamicWind.wind
- (fn () => call errBlocked, finish)
- end
- else raiseSys errno,
- errno = errno, handlers = handlers}
- in
- call errUnblocked
- end
-
- local
- val simpleResult' = fn ({restart}, f) =>
- syscallErr
- ({clear = false, restart = restart}, fn () =>
- let val return = f ()
- in {return = return, post = fn () => return, handlers = []}
- end)
- in
- val simpleResultRestart = fn f =>
- simpleResult' ({restart = true}, f)
- val simpleResult = fn f =>
- simpleResult' ({restart = false}, f)
- end
-
- val simpleRestart = ignore o simpleResultRestart
- val simple = ignore o simpleResult
-
- val syscallRestart = fn f =>
- syscallErr
- ({clear = false, restart = true}, fn () =>
- let val (return, post) = f ()
- in {return = return, post = post, handlers = []}
- end)
- val syscall = fn f =>
- syscallErr
- ({clear = false, restart = false}, fn () =>
- let val (return, post) = f ()
- in {return = return, post = post, handlers = []}
- end)
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,469 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixFileSys: POSIX_FILE_SYS_EXTRA =
- struct
- structure Error = PosixError
-
- (* Patch to make Time look like it deals with Int.int
- * instead of LargeInt.int.
- *)
- structure Time =
- struct
- open Time
-
- val fromSeconds = fromSeconds o LargeInt.fromInt
-
- fun toSeconds t =
- LargeInt.toInt (Time.toSeconds t)
- handle Overflow => Error.raiseSys Error.inval
- end
-
- structure SysCall = Error.SysCall
- structure Prim = PrimitiveFFI.Posix.FileSys
- open Prim
- structure Stat = Prim.Stat
- structure Flags = BitFlags
-
- type file_desc = C.Fd.t
- type uid = C.UId.t
- type gid = C.GId.t
-
- val fdToWord = Primitive.FileDesc.toWord
- val wordToFD = Primitive.FileDesc.fromWord
- val fdToIOD = OS.IO.fromFD
- val iodToFD = SOME o OS.IO.toFD
-
- (*------------------------------------*)
- (* dirstream *)
- (*------------------------------------*)
-
- local
- structure Prim = Prim.Dirstream
- datatype dirstream = DS of C.DirP.t option ref
-
- fun get (DS r) =
- case !r of
- NONE => Error.raiseSys Error.badf
- | SOME d => d
- in
- type dirstream = dirstream
-
- fun opendir s =
- let
- val s = NullString.nullTerm s
- in
- SysCall.syscall
- (fn () =>
- let
- val d = Prim.openDir s
- val p = Primitive.Pointer.fromWord d
- in
- (if Primitive.Pointer.isNull p then ~1 else 0,
- fn () => DS (ref (SOME d)))
- end)
- end
-
- fun readdir d =
- let
- val d = get d
- fun loop () =
- let
- val res =
- SysCall.syscallErr
- ({clear = true, restart = false},
- fn () =>
- let
- val cs = Prim.readDir d
- in
- {return = if Primitive.Pointer.isNull cs
- then ~1
- else 0,
- post = fn () => SOME cs,
- handlers = [(Error.cleared, fn () => NONE),
- (* MinGW sets errno to ENOENT when it
- * returns NULL.
- *)
- (Error.noent, fn () => NONE)]}
- end)
- in
- case res of
- NONE => NONE
- | SOME cs =>
- let
- val s = COld.CS.toString cs
- in
- if s = "." orelse s = ".."
- then loop ()
- else SOME s
- end
- end
- in loop ()
- end
-
- fun rewinddir d =
- let val d = get d
- in
- SysCall.syscallErr
- ({clear = true, restart = false},
- fn () =>
- let val () = Prim.rewindDir d
- in
- {return = ~1,
- post = fn () => (),
- handlers = [(Error.cleared, fn () => ())]}
- end)
- end
-
- fun closedir (DS r) =
- case !r of
- NONE => ()
- | SOME d => (SysCall.simple (fn () => Prim.closeDir d); r := NONE)
- end
-
- fun chdir s =
- SysCall.simple (fn () => Prim.chdir (NullString.nullTerm s))
-
- local
- val size: int ref = ref 1
- fun make () = Primitive.Array.array (!size)
- val buffer = ref (make ())
-
- fun extractToChar (a, c) =
- let
- val n = Array.length a
- (* find the null terminator *)
- fun loop i =
- if i >= n
- then raise Fail "String.extractFromC didn't find terminator"
- else if c = Array.sub (a, i)
- then i
- else loop (i + 1)
- in
- ArraySlice.vector (ArraySlice.slice (a, 0, SOME (loop 0)))
- end
-
- fun extract a = extractToChar (a, #"\000")
- in
- fun getcwd () =
- if Primitive.Pointer.isNull (Prim.getcwd (!buffer, C.Size.fromInt (!size)))
- then (size := 2 * !size
- ; buffer := make ()
- ; getcwd ())
- else extract (!buffer)
- end
-
- val FD = Primitive.FileDesc.fromInt
-
- val stdin = FD 0
- val stdout = FD 1
- val stderr = FD 2
-
- structure S =
- struct
- open S Flags
- type mode = C.Mode.t
- val ifblk = IFBLK
- val ifchr = IFCHR
- val ifdir = IFDIR
- val ififo = IFIFO
- val iflnk = IFLNK
- val ifmt = IFMT
- val ifreg = IFREG
- val ifsock = IFSOCK
- val irgrp = IRGRP
- val iroth = IROTH
- val irusr = IRUSR
- val irwxg = IRWXG
- val irwxo = IRWXO
- val irwxu = IRWXU
- val isgid = ISGID
- val isuid = ISUID
- val isvtx = ISVTX
- val iwgrp = IWGRP
- val iwoth = IWOTH
- val iwusr = IWUSR
- val ixgrp = IXGRP
- val ixoth = IXOTH
- val ixusr = IXUSR
- end
-
- structure O =
- struct
- open O Flags
- val append = SysWord.fromInt APPEND
- val binary = SysWord.fromInt BINARY
- val creat = SysWord.fromInt CREAT
- val dsync = SysWord.fromInt DSYNC
- val excl = SysWord.fromInt EXCL
- val noctty = SysWord.fromInt NOCTTY
- val nonblock = SysWord.fromInt NONBLOCK
- val rdonly = SysWord.fromInt RDONLY
- val rdwr = SysWord.fromInt RDWR
- val rsync = SysWord.fromInt RSYNC
- val sync = SysWord.fromInt SYNC
- val text = SysWord.fromInt TEXT
- val trunc = SysWord.fromInt TRUNC
- val wronly = SysWord.fromInt WRONLY
- end
-
- 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"
-
- val openModeToWord =
- fn O_RDONLY => O.rdonly
- | O_WRONLY => O.wronly
- | O_RDWR => O.rdwr
-
- fun createf (pathname, openMode, flags, mode) =
- let
- val pathname = NullString.nullTerm pathname
- val flags = Flags.flags [openModeToWord openMode,
- flags,
- O.creat]
- val fd =
- SysCall.simpleResult
- (fn () => Prim.open3 (pathname, SysWord.toInt flags, mode))
- in
- FD fd
- end
-
- fun openf (pathname, openMode, flags) =
- let
- val pathname = NullString.nullTerm pathname
- val flags = Flags.flags [openModeToWord openMode, flags]
- val fd =
- SysCall.simpleResult
- (fn () => Prim.open3 (pathname, SysWord.toInt flags, Flags.empty))
- in FD fd
- end
-
- fun creat (s, m) = createf (s, O_WRONLY, O.trunc, m)
-
- val umask = Prim.umask
-
-
- local
- fun wrap p arg = (SysCall.simple (fn () => p arg); ())
- fun wrapRestart p arg = (SysCall.simpleRestart (fn () => p arg); ())
- fun wrapOldNew p =
- wrap (fn {old,new} => p (NullString.nullTerm old,
- NullString.nullTerm new))
- in
- val link = wrapOldNew Prim.link
- val mkdir = wrap (fn (p, m) => Prim.mkdir (NullString.nullTerm p, m))
- val mkfifo = wrap (fn (p, m) => Prim.mkfifo (NullString.nullTerm p, m))
- val unlink = wrap (Prim.unlink o NullString.nullTerm)
- val rmdir = wrap (Prim.rmdir o NullString.nullTerm)
- val rename = wrapOldNew Prim.rename
- val symlink = wrapOldNew Prim.symlink
- val chmod = wrap (fn (p, m) => Prim.chmod (NullString.nullTerm p, m))
- val fchmod = wrap Prim.fchmod
- val chown =
- wrap (fn (s, u, g) => Prim.chown (NullString.nullTerm s, u, g))
- val fchown = wrap Prim.fchown
- val ftruncate = wrapRestart Prim.ftruncate
- end
-
- local
- val size: int = 1024
- val buf : char array = Array.array (size, #"\000")
- in
- fun readlink (path: string): string =
- let
- val path = NullString.nullTerm path
- in
- SysCall.syscall
- (fn () =>
- let val len = Prim.readlink (path, buf, C.Size.fromInt size)
- in
- (len, fn () =>
- ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len)))
- end)
- end
- end
-
- type dev = C.Dev.t
- val wordToDev = C.Dev.fromLargeWord o SysWord.toLargeWord
- val devToWord = SysWord.fromLargeWord o C.Dev.toLargeWord
-
- type ino = C.INo.t
- val wordToIno = C.INo.fromLargeWord o SysWord.toLargeWord
- val inoToWord = SysWord.fromLargeWord o C.INo.toLargeWord
-
- structure ST =
- struct
- datatype stat =
- T of {dev: dev,
- ino: ino,
- mode: S.mode,
- nlink: int,
- uid: uid,
- gid: gid,
- size: Position.int,
- atime: Time.time,
- mtime: Time.time,
- ctime: Time.time}
-
- fun fromC (): stat =
- T {dev = Stat.getDev (),
- ino = Stat.getINo (),
- mode = Stat.getMode (),
- nlink = C.NLink.toInt (Stat.getNLink ()),
- uid = Stat.getUId (),
- gid = Stat.getGId (),
- size = Stat.getSize (),
- atime = Time.fromSeconds (Stat.getATime ()),
- mtime = Time.fromSeconds (Stat.getMTime ()),
- ctime = Time.fromSeconds (Stat.getCTime ())}
-
- local
- fun make sel (T r) = sel r
- in
- val mode = make #mode
- val ino = make #ino
- val dev = make #dev
- val nlink = make #nlink
- val uid = make #uid
- val gid = make #gid
- val size = make #size
- val atime = make #atime
- val mtime = make #mtime
- val ctime = make #ctime
- end
-
- local
- fun make prim s = prim (mode s)
- in
- val isDir = make Prim.ST.isDir
- val isChr = make Prim.ST.isChr
- val isBlk = make Prim.ST.isBlk
- val isReg = make Prim.ST.isReg
- val isFIFO = make Prim.ST.isFIFO
- val isLink = make Prim.ST.isLink
- val isSock = make Prim.ST.isSock
- end
- end
-
- local
- fun make prim arg =
- SysCall.syscall (fn () => (prim arg, fn () => ST.fromC ()))
- in
- val stat = (make Prim.Stat.stat) o NullString.nullTerm
- val lstat = (make Prim.Stat.lstat) o NullString.nullTerm
- val fstat = make Prim.Stat.fstat
- end
-
- datatype access_mode = A_READ | A_WRITE | A_EXEC
-
- val conv_access_mode =
- fn A_READ => A.R_OK
- | A_WRITE => A.W_OK
- | A_EXEC => A.X_OK
-
- 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 path = NullString.nullTerm path
- in
- SysCall.syscallErr
- ({clear = false, restart = false},
- fn () =>
- let val return = Prim.access (path, mode)
- in
- {return = return,
- post = fn () => true,
- handlers = [(Error.acces, fn () => false),
- (Error.loop, fn () => false),
- (Error.nametoolong, fn () => false),
- (Error.noent, fn () => false),
- (Error.notdir, fn () => false),
- (Error.rofs, fn () => false)]}
- end)
- end
-
- local
- structure U = Prim.Utimbuf
- in
- fun utime (f: string, opt: {actime: Time.time,
- modtime: Time.time} option): unit =
- let
- val (a, m) =
- case opt of
- NONE => let val t = Time.now ()
- in (t, t)
- end
- | SOME {actime = a, modtime = m} => (a, m)
- val a = Time.toSeconds a
- val m = Time.toSeconds m
- val f = NullString.nullTerm f
- in
- SysCall.syscallRestart
- (fn () =>
- (U.setAcTime a
- ; U.setModTime m
- ; (U.utime f, fn () =>
- ())))
- end
- end
-
- local
- local
- open Prim.PC
- in
- val properties =
- [
- (ALLOC_SIZE_MIN,"ALLOC_SIZE_MIN"),
- (ASYNC_IO,"ASYNC_IO"),
- (CHOWN_RESTRICTED,"CHOWN_RESTRICTED"),
- (FILESIZEBITS,"FILESIZEBITS"),
- (LINK_MAX,"LINK_MAX"),
- (MAX_CANON,"MAX_CANON"),
- (MAX_INPUT,"MAX_INPUT"),
- (NAME_MAX,"NAME_MAX"),
- (NO_TRUNC,"NO_TRUNC"),
- (PATH_MAX,"PATH_MAX"),
- (PIPE_BUF,"PIPE_BUF"),
- (PRIO_IO,"PRIO_IO"),
- (REC_INCR_XFER_SIZE,"REC_INCR_XFER_SIZE"),
- (REC_MAX_XFER_SIZE,"REC_MAX_XFER_SIZE"),
- (REC_MIN_XFER_SIZE,"REC_MIN_XFER_SIZE"),
- (REC_XFER_ALIGN,"REC_XFER_ALIGN"),
- (SYMLINK_MAX,"SYMLINK_MAX"),
- (SYNC_IO,"SYNC_IO"),
- (VDISABLE,"VDISABLE")
- ]
- end
-
- fun convertProperty s =
- case List.find (fn (_, s') => s = s') properties of
- NONE => Error.raiseSys Error.inval
- | SOME (n, _) => n
-
- fun make prim (f, s) =
- SysCall.syscallErr
- ({clear = true, restart = false},
- fn () =>
- let
- val return = prim (f, convertProperty s)
- in
- {return = return,
- post = fn () => SOME (SysWord.fromInt return),
- handlers = [(Error.cleared, fn () => NONE)]}
- end)
- in
- val pathconf =
- make (fn (path, s) => Prim.pathconf (NullString.nullTerm path, s))
- val fpathconf = make Prim.fpathconf
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,401 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixIO: POSIX_IO =
-struct
-
-structure Prim = PrimitiveFFI.Posix.IO
-open Prim
-structure Error = PosixError
-structure SysCall = Error.SysCall
-structure FS = PosixFileSys
-
-type file_desc = C.Fd.t
-type pid = C.PId.t
-
-val FD = C.Fd.fromInt
-val unFD = C.Fd.toInt
-
-local
- val a: file_desc array = Array.array (2, FD 0)
-in
- fun pipe () =
- SysCall.syscall
- (fn () =>
- (Prim.pipe a,
- fn () => {infd = Array.sub (a, 0),
- outfd = Array.sub (a, 1)}))
-end
-
-fun dup fd = FD (SysCall.simpleResult (fn () => Prim.dup fd))
-
-fun dup2 {new, old} = SysCall.simple (fn () => Prim.dup2 (old, new))
-
-fun close fd = SysCall.simpleRestart (fn () => Prim.close fd)
-
-structure FD =
- struct
- open FD BitFlags
- val cloexec = SysWord.fromInt CLOEXEC
- end
-
-structure O = PosixFileSys.O
-
-datatype open_mode = datatype PosixFileSys.open_mode
-
-fun dupfd {base, old} =
- FD (SysCall.simpleResultRestart
- (fn () => Prim.fcntl3 (old, F_DUPFD, unFD base)))
-
-fun getfd fd =
- Word.fromInt (SysCall.simpleResultRestart
- (fn () => Prim.fcntl2 (fd, F_GETFD)))
-
-fun setfd (fd, flags): unit =
- SysCall.simpleRestart
- (fn () => Prim.fcntl3 (fd, F_SETFD, Word.toIntX flags))
-
-fun getfl fd : O.flags * open_mode =
- let
- val n =
- SysCall.simpleResultRestart (fn () => Prim.fcntl2 (fd, F_GETFL))
- val w = Word.fromInt n
- val flags = Word.andb (w, Word.notb (Word.fromInt O_ACCMODE))
- val mode = Word.andb (w, (Word.fromInt O_ACCMODE))
- in (flags, PosixFileSys.wordToOpenMode mode)
- end
-
-fun setfl (fd, flags: O.flags): unit =
- SysCall.simpleRestart
- (fn () => Prim.fcntl3 (fd, F_SETFL, Word.toIntX flags))
-
-datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
-
-val whenceToInt =
- fn SEEK_SET => Prim.SEEK_SET
- | SEEK_CUR => Prim.SEEK_CUR
- | SEEK_END => Prim.SEEK_END
-
-fun lseek (fd, n: Position.int, w: whence): Position.int =
- SysCall.syscall
- (fn () =>
- let val n = Prim.lseek (fd, n, whenceToInt w)
- in (if n = ~1 then ~1 else 0, fn () => n)
- end)
-
-fun fsync fd : unit = SysCall.simple (fn () => Prim.fsync fd)
-
-val whenceToInt =
- fn SEEK_SET => Prim.FLock.SEEK_SET
- | SEEK_CUR => Prim.FLock.SEEK_CUR
- | SEEK_END => Prim.FLock.SEEK_END
-
-fun intToWhence n =
- if n = Prim.FLock.SEEK_SET
- then SEEK_SET
- else if n = Prim.FLock.SEEK_CUR
- then SEEK_CUR
- else if n = Prim.FLock.SEEK_END
- then SEEK_END
- else raise Fail "Posix.IO.intToWhence"
-
-datatype lock_type =
- F_RDLCK
- | F_WRLCK
- | F_UNLCK
-
-val lockTypeToInt =
- fn F_RDLCK => Prim.FLock.F_RDLCK
- | F_WRLCK => Prim.FLock.F_WRLCK
- | F_UNLCK => Prim.FLock.F_UNLCK
-
-fun intToLockType n =
- if n = Prim.FLock.F_RDLCK
- then F_RDLCK
- else if n = Prim.FLock.F_WRLCK
- then F_WRLCK
- else if n = Prim.FLock.F_UNLCK
- then F_UNLCK
- else raise Fail "Posix.IO.intToLockType"
-
-structure FLock =
- struct
- open FLock
-
- type flock = {ltype: lock_type,
- whence: whence,
- start: Position.int,
- len: Position.int,
- pid: pid option}
-
- fun flock l = l
- val ltype: flock -> lock_type = #ltype
- val whence: flock -> whence = #whence
- val start: flock -> Position.int = #start
- val len: flock -> Position.int = #len
- val pid: flock -> pid option = #pid
- end
-
-local
- structure P = Prim.FLock
- fun make
- (cmd, usepid)
- (fd, {ltype, whence, start, len, ...}: FLock.flock)
- : FLock.flock =
- SysCall.syscallRestart
- (fn () =>
- ((P.setType (lockTypeToInt ltype)
- ; P.setWhence (whenceToInt whence)
- ; P.setStart start
- ; P.setLen len
- ; P.fcntl (fd, cmd)), fn () =>
- {ltype = intToLockType (P.getType ()),
- whence = intToWhence (P.getWhence ()),
- start = P.getStart (),
- len = P.getLen (),
- pid = if usepid then SOME (P.getPId ()) else NONE}))
-in
- val getlk = make (FLock.F_GETLK, true)
- val setlk = make (FLock.F_SETLK, false)
- val setlkw = make (FLock.F_SETLKW, false)
-end
-
-(* Adapted from SML/NJ sources. *)
-(* posix-bin-prim-io.sml
- *
- * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
- *
- * This implements the UNIX version of the OS specific binary primitive
- * IO structure. The Text IO version is implemented by a trivial translation
- * of these operations (see posix-text-prim-io.sml).
- *
- *)
-local
- val pos0 = Position.fromInt 0
- fun isReg fd = FS.ST.isReg(FS.fstat fd)
- fun posFns (closed, fd) =
- if (isReg fd)
- then let
- val pos = ref pos0
- fun getPos () = !pos
- fun setPos p = (if !closed
- then raise IO.ClosedStream
- else ();
- pos := lseek(fd,p,SEEK_SET))
- fun endPos () = (if !closed
- then raise IO.ClosedStream
- else ();
- FS.ST.size(FS.fstat fd))
- fun verifyPos () = let
- val curPos = lseek(fd, pos0, SEEK_CUR)
- in
- pos := curPos; curPos
- end
- val _ = verifyPos ()
- in
- {pos = pos,
- getPos = SOME getPos,
- setPos = SOME setPos,
- endPos = SOME endPos,
- verifyPos = SOME verifyPos}
- end
- else {pos = ref pos0,
- getPos = NONE,
- setPos = NONE,
- endPos = NONE,
- verifyPos = NONE}
-
- fun make {RD, WR, fromVector, read, setMode, toArraySlice, toVectorSlice,
- vectorLength, write, writeVec} =
- let
- val setMode =
- fn fd =>
- if let
- open Primitive.MLton.Platform.OS
- in
- case host of
- MinGW => true
- | _ => false
- end
- then setMode fd
- else ()
- fun readArr (fd, sl): int =
- let
- val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
- in
- SysCall.simpleResultRestart (fn () => read (fd, buf, i, C.Size.fromInt sz))
- end
- fun readVec (fd, n) =
- let
- val a = Primitive.Array.array n
- val bytesRead =
- SysCall.simpleResultRestart (fn () => read (fd, a, 0, C.Size.fromInt n))
- in
- fromVector
- (if n = bytesRead
- then Vector.fromArray a
- else ArraySlice.vector (ArraySlice.slice
- (a, 0, SOME bytesRead)))
- end
- fun writeArr (fd, sl) =
- let
- val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
- in
- SysCall.simpleResultRestart
- (fn () => write (fd, buf, i, C.Size.fromInt sz))
- end
- val writeVec =
- fn (fd, sl) =>
- let
- val (buf, i, sz) = VectorSlice.base (toVectorSlice sl)
- in
- SysCall.simpleResultRestart
- (fn () => writeVec (fd, buf, i, C.Size.fromInt sz))
- end
- fun mkReader {fd, name, initBlkMode} =
- let
- val closed = ref false
- val {pos, getPos, setPos, endPos, verifyPos} =
- posFns (closed, fd)
- val blocking = ref initBlkMode
- fun blockingOn () =
- (setfl(fd, O.flags[]); blocking := true)
- fun blockingOff () =
- (setfl(fd, O.nonblock); blocking := false)
- fun ensureOpen () =
- if !closed then raise IO.ClosedStream else ()
- fun incPos k = pos := Position.+ (!pos, Position.fromInt k)
- val readVec = fn n =>
- let val v = readVec (fd, n)
- in incPos (vectorLength v); v
- end
- val readArr = fn x =>
- let val k = readArr (fd, x)
- in incPos k; k
- end
- fun blockWrap f x =
- (ensureOpen ();
- if !blocking then () else blockingOn ();
- f x)
- fun noBlockWrap f x =
- (ensureOpen ();
- if !blocking then blockingOff () else ();
- (SOME (f x)
- handle (e as PosixError.SysErr (_, SOME cause)) =>
- if cause = PosixError.again then NONE else raise e))
- val close =
- fn () => if !closed then () else (closed := true; close fd)
- val avail =
- if isReg fd
- then fn () => if !closed
- then SOME 0
- else SOME (Position.toInt
- (Position.-
- (FS.ST.size (FS.fstat fd),
- !pos)))
- else fn () => if !closed then SOME 0 else NONE
- val () = setMode fd
- in
- RD {avail = avail,
- block = NONE,
- canInput = NONE,
- chunkSize = Primitive.TextIO.bufSize,
- close = close,
- endPos = endPos,
- getPos = getPos,
- ioDesc = SOME (FS.fdToIOD fd),
- name = name,
- readArr = SOME (blockWrap readArr),
- readArrNB = SOME (noBlockWrap readArr),
- readVec = SOME (blockWrap readVec),
- readVecNB = SOME (noBlockWrap readVec),
- setPos = setPos,
- verifyPos = verifyPos}
- end
- fun mkWriter {fd, name, initBlkMode, appendMode, chunkSize} =
- let
- val closed = ref false
- val {pos, getPos, setPos, endPos, verifyPos} =
- posFns (closed, fd)
- fun incPos k = (pos := Position.+ (!pos, Position.fromInt k); k)
- val blocking = ref initBlkMode
- val appendFlgs = O.flags(if appendMode then [O.append] else [])
- fun updateStatus () =
- let
- val flgs = if !blocking
- then appendFlgs
- else O.flags [O.nonblock, appendFlgs]
- in
- setfl(fd, flgs)
- end
- fun ensureOpen () =
- if !closed then raise IO.ClosedStream else ()
- fun ensureBlock x =
- if !blocking then () else (blocking := x; updateStatus ())
- fun putV x = incPos (writeVec x)
- fun putA x = incPos (writeArr x)
- fun write (put, block) arg =
- (ensureOpen (); ensureBlock block; put (fd, arg))
- fun handleBlock writer arg =
- SOME(writer arg)
- handle (e as PosixError.SysErr (_, SOME cause)) =>
- if cause = PosixError.again then NONE else raise e
- val close =
- fn () => if !closed then () else (closed := true; close fd)
- val () = setMode fd
- in
- WR {block = NONE,
- canOutput = NONE,
- chunkSize = chunkSize,
- close = close,
- endPos = endPos,
- getPos = getPos,
- ioDesc = SOME (FS.fdToIOD fd),
- name = name,
- setPos = setPos,
- verifyPos = verifyPos,
- writeArr = SOME (write (putA, true)),
- writeArrNB = SOME (handleBlock (write (putA, false))),
- writeVec = SOME (write (putV, true)),
- writeVecNB = SOME (handleBlock (write (putV, false)))}
- end
- in
- {mkReader = mkReader,
- mkWriter = mkWriter,
- readArr = readArr,
- readVec = readVec,
- writeArr = writeArr,
- writeVec = writeVec}
- end
-in
- val {mkReader = mkBinReader, mkWriter = mkBinWriter,
- readArr, readVec, writeArr, writeVec} =
- make {RD = BinPrimIO.RD,
- WR = BinPrimIO.WR,
- fromVector = Word8Vector.fromPoly,
- read = readWord8,
- setMode = Prim.setbin,
- toArraySlice = Word8ArraySlice.toPoly,
- toVectorSlice = Word8VectorSlice.toPoly,
- vectorLength = Word8Vector.length,
- write = writeWord8Arr,
- writeVec = writeWord8Vec}
- val {mkReader = mkTextReader, mkWriter = mkTextWriter, ...} =
- make {RD = TextPrimIO.RD,
- WR = TextPrimIO.WR,
- fromVector = fn v => v,
- read = readChar8,
- setMode = Prim.settext,
- toArraySlice = CharArraySlice.toPoly,
- toVectorSlice = CharVectorSlice.toPoly,
- vectorLength = CharVector.length,
- write = writeChar8Arr,
- writeVec = writeChar8Vec}
-end
-
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,267 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixProcEnv: POSIX_PROC_ENV =
- struct
- structure Prim = PrimitiveFFI.Posix.ProcEnv
- structure Error = PosixError
- structure SysCall = Error.SysCall
- structure CS = COld.CS
-
- type pid = C.PId.t
- type uid = C.UId.t
- type gid = C.GId.t
- type file_desc = C.Fd.t
-
- local
- open Prim
- in
- val getpgrp = getpgrp (* No error checking required *)
- val getegid = getegid (* No error checking required *)
- val geteuid = geteuid (* No error checking required *)
- val getgid = getgid (* No error checking required *)
- val getpid = getpid (* No error checking required *)
- val getppid = getppid (* No error checking required *)
- val getuid = getuid (* No error checking required *)
- val setgid = fn gid => SysCall.simple (fn () => setgid gid)
- val setuid = fn uid => SysCall.simple (fn () => setuid uid)
- end
-
- fun setsid () = SysCall.simpleResult (Prim.setsid)
-
- fun id x = x
- val uidToWord = id
- val wordToUid = id
- val gidToWord = id
- val wordToGid = id
-
- local
- val n = Prim.getgroupsN ()
- val a: word array = Primitive.Array.array n
- in
- fun getgroups () =
- SysCall.syscall
- (fn () =>
- let val n = Prim.getgroups (n, a)
- in (n, fn () =>
- ArraySlice.toList (ArraySlice.slice (a, 0, SOME n)))
- end)
- end
-
- fun getlogin () =
- let val cs = Prim.getlogin ()
- in if Primitive.Pointer.isNull cs
- then raise (Error.SysErr ("no login name", NONE))
- else CS.toString cs
- end
-
- fun setpgid {pid, pgid} =
- let
- val pid = case pid of NONE => 0 | SOME pid => pid
- val pgid = case pgid of NONE => 0 | SOME pgid => pgid
- in
- SysCall.simple
- (fn () => Prim.setpgid (pid, pgid))
- end
-
- fun uname () =
- SysCall.syscall
- (fn () =>
- (Prim.uname (), fn () =>
- [("sysname", CS.toString (Prim.Uname.getSysName ())),
- ("nodename", CS.toString (Prim.Uname.getNodeName ())),
- ("release", CS.toString (Prim.Uname.getRelease ())),
- ("version", CS.toString (Prim.Uname.getVersion ())),
- ("machine", CS.toString (Prim.Uname.getMachine ()))]))
-
- val time = Time.now
-
- local
- val sysconfNames =
- [
- (Prim.SC_2_CHAR_TERM,"2_CHAR_TERM"),
- (Prim.SC_2_C_BIND,"2_C_BIND"),
- (Prim.SC_2_C_DEV,"2_C_DEV"),
- (Prim.SC_2_FORT_DEV,"2_FORT_DEV"),
- (Prim.SC_2_FORT_RUN,"2_FORT_RUN"),
- (Prim.SC_2_LOCALEDEF,"2_LOCALEDEF"),
- (Prim.SC_2_PBS,"2_PBS"),
- (Prim.SC_2_PBS_ACCOUNTING,"2_PBS_ACCOUNTING"),
- (Prim.SC_2_PBS_CHECKPOINT,"2_PBS_CHECKPOINT"),
- (Prim.SC_2_PBS_LOCATE,"2_PBS_LOCATE"),
- (Prim.SC_2_PBS_MESSAGE,"2_PBS_MESSAGE"),
- (Prim.SC_2_PBS_TRACK,"2_PBS_TRACK"),
- (Prim.SC_2_SW_DEV,"2_SW_DEV"),
- (Prim.SC_2_UPE,"2_UPE"),
- (Prim.SC_2_VERSION,"2_VERSION"),
- (Prim.SC_ADVISORY_INFO,"ADVISORY_INFO"),
- (Prim.SC_AIO_LISTIO_MAX,"AIO_LISTIO_MAX"),
- (Prim.SC_AIO_MAX,"AIO_MAX"),
- (Prim.SC_AIO_PRIO_DELTA_MAX,"AIO_PRIO_DELTA_MAX"),
- (Prim.SC_ARG_MAX,"ARG_MAX"),
- (Prim.SC_ASYNCHRONOUS_IO,"ASYNCHRONOUS_IO"),
- (Prim.SC_ATEXIT_MAX,"ATEXIT_MAX"),
- (Prim.SC_BARRIERS,"BARRIERS"),
- (Prim.SC_BC_BASE_MAX,"BC_BASE_MAX"),
- (Prim.SC_BC_DIM_MAX,"BC_DIM_MAX"),
- (Prim.SC_BC_SCALE_MAX,"BC_SCALE_MAX"),
- (Prim.SC_BC_STRING_MAX,"BC_STRING_MAX"),
- (Prim.SC_CHILD_MAX,"CHILD_MAX"),
- (Prim.SC_CLK_TCK,"CLK_TCK"),
- (Prim.SC_CLOCK_SELECTION,"CLOCK_SELECTION"),
- (Prim.SC_COLL_WEIGHTS_MAX,"COLL_WEIGHTS_MAX"),
- (Prim.SC_CPUTIME,"CPUTIME"),
- (Prim.SC_DELAYTIMER_MAX,"DELAYTIMER_MAX"),
- (Prim.SC_EXPR_NEST_MAX,"EXPR_NEST_MAX"),
- (Prim.SC_FSYNC,"FSYNC"),
- (Prim.SC_GETGR_R_SIZE_MAX,"GETGR_R_SIZE_MAX"),
- (Prim.SC_GETPW_R_SIZE_MAX,"GETPW_R_SIZE_MAX"),
- (Prim.SC_HOST_NAME_MAX,"HOST_NAME_MAX"),
- (Prim.SC_IOV_MAX,"IOV_MAX"),
- (Prim.SC_IPV6,"IPV6"),
- (Prim.SC_JOB_CONTROL,"JOB_CONTROL"),
- (Prim.SC_LINE_MAX,"LINE_MAX"),
- (Prim.SC_LOGIN_NAME_MAX,"LOGIN_NAME_MAX"),
- (Prim.SC_MAPPED_FILES,"MAPPED_FILES"),
- (Prim.SC_MEMLOCK,"MEMLOCK"),
- (Prim.SC_MEMLOCK_RANGE,"MEMLOCK_RANGE"),
- (Prim.SC_MEMORY_PROTECTION,"MEMORY_PROTECTION"),
- (Prim.SC_MESSAGE_PASSING,"MESSAGE_PASSING"),
- (Prim.SC_MONOTONIC_CLOCK,"MONOTONIC_CLOCK"),
- (Prim.SC_MQ_OPEN_MAX,"MQ_OPEN_MAX"),
- (Prim.SC_MQ_PRIO_MAX,"MQ_PRIO_MAX"),
- (Prim.SC_NGROUPS_MAX,"NGROUPS_MAX"),
- (Prim.SC_OPEN_MAX,"OPEN_MAX"),
- (Prim.SC_PAGESIZE,"PAGESIZE"),
- (Prim.SC_PAGE_SIZE,"PAGE_SIZE"),
- (Prim.SC_PRIORITIZED_IO,"PRIORITIZED_IO"),
- (Prim.SC_PRIORITY_SCHEDULING,"PRIORITY_SCHEDULING"),
- (Prim.SC_RAW_SOCKETS,"RAW_SOCKETS"),
- (Prim.SC_READER_WRITER_LOCKS,"READER_WRITER_LOCKS"),
- (Prim.SC_REALTIME_SIGNALS,"REALTIME_SIGNALS"),
- (Prim.SC_REGEXP,"REGEXP"),
- (Prim.SC_RE_DUP_MAX,"RE_DUP_MAX"),
- (Prim.SC_RTSIG_MAX,"RTSIG_MAX"),
- (Prim.SC_SAVED_IDS,"SAVED_IDS"),
- (Prim.SC_SEMAPHORES,"SEMAPHORES"),
- (Prim.SC_SEM_NSEMS_MAX,"SEM_NSEMS_MAX"),
- (Prim.SC_SEM_VALUE_MAX,"SEM_VALUE_MAX"),
- (Prim.SC_SHARED_MEMORY_OBJECTS,"SHARED_MEMORY_OBJECTS"),
- (Prim.SC_SHELL,"SHELL"),
- (Prim.SC_SIGQUEUE_MAX,"SIGQUEUE_MAX"),
- (Prim.SC_SPAWN,"SPAWN"),
- (Prim.SC_SPIN_LOCKS,"SPIN_LOCKS"),
- (Prim.SC_SPORADIC_SERVER,"SPORADIC_SERVER"),
- (Prim.SC_SS_REPL_MAX,"SS_REPL_MAX"),
- (Prim.SC_STREAM_MAX,"STREAM_MAX"),
- (Prim.SC_SYMLOOP_MAX,"SYMLOOP_MAX"),
- (Prim.SC_SYNCHRONIZED_IO,"SYNCHRONIZED_IO"),
- (Prim.SC_THREADS,"THREADS"),
- (Prim.SC_THREAD_ATTR_STACKADDR,"THREAD_ATTR_STACKADDR"),
- (Prim.SC_THREAD_ATTR_STACKSIZE,"THREAD_ATTR_STACKSIZE"),
- (Prim.SC_THREAD_CPUTIME,"THREAD_CPUTIME"),
- (Prim.SC_THREAD_DESTRUCTOR_ITERATIONS,"THREAD_DESTRUCTOR_ITERATIONS"),
- (Prim.SC_THREAD_KEYS_MAX,"THREAD_KEYS_MAX"),
- (Prim.SC_THREAD_PRIORITY_SCHEDULING,"THREAD_PRIORITY_SCHEDULING"),
- (Prim.SC_THREAD_PRIO_INHERIT,"THREAD_PRIO_INHERIT"),
- (Prim.SC_THREAD_PRIO_PROTECT,"THREAD_PRIO_PROTECT"),
- (Prim.SC_THREAD_PROCESS_SHARED,"THREAD_PROCESS_SHARED"),
- (Prim.SC_THREAD_SAFE_FUNCTIONS,"THREAD_SAFE_FUNCTIONS"),
- (Prim.SC_THREAD_SPORADIC_SERVER,"THREAD_SPORADIC_SERVER"),
- (Prim.SC_THREAD_STACK_MIN,"THREAD_STACK_MIN"),
- (Prim.SC_THREAD_THREADS_MAX,"THREAD_THREADS_MAX"),
- (Prim.SC_TIMEOUTS,"TIMEOUTS"),
- (Prim.SC_TIMERS,"TIMERS"),
- (Prim.SC_TIMER_MAX,"TIMER_MAX"),
- (Prim.SC_TRACE,"TRACE"),
- (Prim.SC_TRACE_EVENT_FILTER,"TRACE_EVENT_FILTER"),
- (Prim.SC_TRACE_EVENT_NAME_MAX,"TRACE_EVENT_NAME_MAX"),
- (Prim.SC_TRACE_INHERIT,"TRACE_INHERIT"),
- (Prim.SC_TRACE_LOG,"TRACE_LOG"),
- (Prim.SC_TRACE_NAME_MAX,"TRACE_NAME_MAX"),
- (Prim.SC_TRACE_SYS_MAX,"TRACE_SYS_MAX"),
- (Prim.SC_TRACE_USER_EVENT_MAX,"TRACE_USER_EVENT_MAX"),
- (Prim.SC_TTY_NAME_MAX,"TTY_NAME_MAX"),
- (Prim.SC_TYPED_MEMORY_OBJECTS,"TYPED_MEMORY_OBJECTS"),
- (Prim.SC_TZNAME_MAX,"TZNAME_MAX"),
- (Prim.SC_V6_ILP32_OFF32,"V6_ILP32_OFF32"),
- (Prim.SC_V6_ILP32_OFFBIG,"V6_ILP32_OFFBIG"),
- (Prim.SC_V6_LP64_OFF64,"V6_LP64_OFF64"),
- (Prim.SC_V6_LPBIG_OFFBIG,"V6_LPBIG_OFFBIG"),
- (Prim.SC_VERSION,"VERSION"),
- (Prim.SC_XBS5_ILP32_OFF32,"XBS5_ILP32_OFF32"),
- (Prim.SC_XBS5_ILP32_OFFBIG,"XBS5_ILP32_OFFBIG"),
- (Prim.SC_XBS5_LP64_OFF64,"XBS5_LP64_OFF64"),
- (Prim.SC_XBS5_LPBIG_OFFBIG,"XBS5_LPBIG_OFFBIG"),
- (Prim.SC_XOPEN_CRYPT,"XOPEN_CRYPT"),
- (Prim.SC_XOPEN_ENH_I18N,"XOPEN_ENH_I18N"),
- (Prim.SC_XOPEN_LEGACY,"XOPEN_LEGACY"),
- (Prim.SC_XOPEN_REALTIME,"XOPEN_REALTIME"),
- (Prim.SC_XOPEN_REALTIME_THREADS,"XOPEN_REALTIME_THREADS"),
- (Prim.SC_XOPEN_SHM,"XOPEN_SHM"),
- (Prim.SC_XOPEN_STREAMS,"XOPEN_STREAMS"),
- (Prim.SC_XOPEN_UNIX,"XOPEN_UNIX"),
- (Prim.SC_XOPEN_VERSION,"XOPEN_VERSION")
- ]
- in
- fun sysconf s =
- case List.find (fn (_, s') => s = s') sysconfNames of
- NONE => Error.raiseSys Error.inval
- | SOME (n, _) =>
- (SysWord.fromInt o SysCall.simpleResult)
- (fn () => Prim.sysconf n)
- end
-
- local
- structure Times = Prim.Times
-
- val ticksPerSec = Int.toLarge (SysWord.toIntX (sysconf "CLK_TCK"))
-
- fun cvt (ticks: C.Clock.t) =
- Time.fromTicks (LargeInt.quot
- (LargeInt.* (C.Clock.toLarge ticks,
- Time.ticksPerSecond),
- ticksPerSec))
- in
- fun times () =
- SysCall.syscall
- (fn () =>
- let val elapsed = Prim.times ()
- in (0, fn () =>
- {elapsed = cvt elapsed,
- utime = cvt (Times.getUTime ()),
- stime = cvt (Times.getSTime ()),
- cutime = cvt (Times.getCUTime ()),
- cstime = cvt (Times.getCSTime ())})
- end)
- end
-
- fun environ () = COld.CSS.toList (Prim.environGet ())
-
- fun getenv name =
- let
- val cs = Prim.getenv (NullString.nullTerm name)
- in
- if Primitive.Pointer.isNull cs
- then NONE
- else SOME (CS.toString cs)
- end
-
- fun ctermid () = CS.toString (Prim.ctermid ())
-
- fun isatty fd = Prim.isatty fd
-
- fun ttyname fd =
- SysCall.syscall
- (fn () =>
- let val cs = Prim.ttyname fd
- in
- (if Primitive.Pointer.isNull cs then ~1 else 0,
- fn () => CS.toString cs)
- end)
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,206 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixProcess: POSIX_PROCESS_EXTRA =
- struct
- structure Prim = PrimitiveFFI.Posix.Process
- open Prim
- structure Error = PosixError
- structure SysCall = Error.SysCall
-
- type signal = PosixSignal.signal
- type pid = Pid.t
-
- val wordToPid = Pid.fromInt o SysWord.toInt
- val pidToWord = SysWord.fromInt o Pid.toInt
-
- fun fork () =
- SysCall.syscall
- (fn () =>
- let
- val p = Prim.fork ()
- val p' = Pid.toInt p
- in (p', fn () => if p' = 0 then NONE else SOME p)
- end)
-
- val fork =
- if Primitive.MLton.Platform.OS.forkIsEnabled
- then fork
- else fn () => Error.raiseSys Error.nosys
-
- val conv = NullString.nullTerm
- val convs = COld.CSS.fromList
-
- fun exece (path, args, env): 'a =
- let
- val path = conv path
- val args = convs args
- val env = convs env
- in
- (SysCall.simple
- (fn () => Prim.exece (path, args, env))
- ; raise Fail "Posix.Process.exece")
- end
-
- fun exec (path, args): 'a =
- exece (path, args, PosixProcEnv.environ ())
-
- fun execp (file, args): 'a =
- let
- val file = conv file
- val args = convs args
- in
- (SysCall.simple
- (fn () => Prim.execp (file, args))
- ; raise Fail "Posix.Process.execp")
- end
-
- datatype waitpid_arg =
- W_ANY_CHILD
- | W_CHILD of pid
- | W_SAME_GROUP
- | W_GROUP of pid
-
- datatype exit_status =
- W_EXITED
- | W_EXITSTATUS of Word8.word
- | W_SIGNALED of signal
- | W_STOPPED of signal
-
- fun fromStatus status =
- if Prim.ifExited status
- then (case Prim.exitStatus status of
- 0 => W_EXITED
- | n => W_EXITSTATUS (Word8.fromInt n))
- else if Prim.ifSignaled status
- then W_SIGNALED (Prim.termSig status)
- else if Prim.ifStopped status
- then W_STOPPED (Prim.stopSig status)
- else raise Fail "Posix.Process.fromStatus"
-
- structure W =
- struct
- open W BitFlags
- val continued = SysWord.fromInt CONTINUED
- val nohang = SysWord.fromInt NOHANG
- val untraced = SysWord.fromInt UNTRACED
- end
-
- local
- val status: C.Status.t ref = ref (C.Status.fromInt 0)
- fun wait (wa, status, flags) =
- let
- val useCwait =
- Primitive.MLton.Platform.OS.useWindowsProcess
- andalso case wa of W_CHILD _ => true | _ => false
- val p =
- case wa of
- W_ANY_CHILD => ~1
- | W_CHILD pid => Pid.toInt pid
- | W_SAME_GROUP => 0
- | W_GROUP pid => ~ (Pid.toInt pid)
- val flags = W.flags flags
- in
- SysCall.syscallRestart
- (fn () =>
- let
- val pid =
- if useCwait
- then PrimitiveFFI.MLton.Process.cwait (Pid.fromInt p, status)
- else Prim.waitpid (Pid.fromInt p, status,
- SysWord.toInt flags)
- in
- (Pid.toInt pid, fn () => pid)
- end)
- end
- fun getStatus () = fromStatus (!status)
- in
- fun waitpid (wa, flags) =
- let
- val pid = wait (wa, status, flags)
- in
- (pid, getStatus ())
- end
-
- fun waitpid_nh (wa, flags) =
- let
- val pid = wait (wa, status, W.nohang :: flags)
- in
- if 0 = Pid.toInt pid
- then NONE
- else SOME (pid, getStatus ())
- end
- end
-
- fun wait () = waitpid (W_ANY_CHILD, [])
-
- fun exit (w: Word8.word): 'a =
- (* Posix.Process.exit does not call atExit cleaners, as per the basis
- * library spec.
- *)
- (Prim.exit (Word8.toInt w)
- ; raise Fail "Posix.Process.exit")
-
- datatype killpid_arg =
- K_PROC of pid
- | K_SAME_GROUP
- | K_GROUP of pid
-
- fun kill (ka: killpid_arg, s: signal): unit =
- let
- val pid =
- case ka of
- K_PROC pid => Pid.toInt pid
- | K_SAME_GROUP => ~1
- | K_GROUP pid => ~ (Pid.toInt pid)
- in
- SysCall.simple (fn () => Prim.kill (Pid.fromInt pid, s))
- end
-
- local
- fun wrap prim (t: Time.time): Time.time =
- Time.fromSeconds
- (LargeInt.fromInt
- (C.UInt.toInt
- (prim
- (C.UInt.fromInt
- (LargeInt.toInt (Time.toSeconds t)
- handle Overflow => Error.raiseSys Error.inval)))))
- in
- val alarm = wrap Prim.alarm
-(* val sleep = wrap Prim.sleep *)
- end
-
- fun sleep (t: Time.time): Time.time =
- let
- val (sec, nsec) = IntInf.quotRem (Time.toNanoseconds t, 1000000000)
- val (sec, nsec) =
- (IntInf.toInt sec, IntInf.toInt nsec)
- handle Overflow => Error.raiseSys Error.inval
- val secRem = ref sec
- val nsecRem = ref nsec
- fun remaining () =
- Time.+ (Time.fromSeconds (Int.toLarge (!secRem)),
- Time.fromNanoseconds (Int.toLarge (!nsecRem)))
- in
- SysCall.syscallErr
- ({clear = false, restart = false}, fn () =>
- {handlers = [(Error.intr, remaining)],
- post = remaining,
- return = Prim.nanosleep (secRem, nsecRem)})
- end
-
- (* FIXME: pause *)
- fun pause () =
- SysCall.syscallErr
- ({clear = false, restart = false},
- fn () =>
- {return = Prim.pause (),
- post = fn () => (),
- handlers = [(Error.intr, fn () => ())]})
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/signal.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,49 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixSignal: POSIX_SIGNAL_EXTRA =
- struct
- open PrimitiveFFI.Posix.Signal
-
- type signal = C.Int.t
-
- val abrt = SIGABRT
- val alrm = SIGALRM
- val bus = SIGBUS
- val chld = SIGCHLD
- val cont = SIGCONT
- val fpe = SIGFPE
- val hup = SIGHUP
- val ill = SIGILL
- val int = SIGINT
- val kill = SIGKILL
- val pipe = SIGPIPE
- val poll = SIGPOLL
- val prof = SIGPROF
- val quit = SIGQUIT
- val segv = SIGSEGV
- val stop = SIGSTOP
- val sys = SIGSYS
- val term = SIGTERM
- val trap = SIGTRAP
- val tstp = SIGTSTP
- val ttin = SIGTTIN
- val ttou = SIGTTOU
- val urg = SIGURG
- val usr1 = SIGUSR1
- val usr2 = SIGUSR2
- val vtalrm = SIGVTALRM
- val xcpu = SIGXCPU
- val xfsz = SIGXFSZ
-
- val toInt = C.Int.toInt
- val fromInt = C.Int.fromInt
-
- val toWord = SysWord.fromInt o toInt
- val fromWord = fromInt o SysWord.toInt
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/signal.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,80 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixSysDB: POSIX_SYS_DB =
- struct
- structure CS = COld.CS
- structure Prim = PrimitiveFFI.Posix.SysDB
- structure Error = PosixError
- structure SysCall = Error.SysCall
-
- type uid = C.UId.t
- type gid = C.GId.t
-
- structure Passwd =
- struct
- type passwd = {name: string,
- uid: uid,
- gid: gid,
- home: string,
- shell: string}
-
- structure Passwd = Prim.Passwd
-
- fun fromC (f: unit -> bool): passwd =
- SysCall.syscall
- (fn () =>
- (if f () then 0 else ~1,
- fn () => {name = CS.toString(Passwd.getName ()),
- uid = Passwd.getUId (),
- gid = Passwd.getGId (),
- home = CS.toString(Passwd.getDir ()),
- shell = CS.toString(Passwd.getShell ())}))
-
- val name: passwd -> string = #name
- val uid: passwd -> uid = #uid
- val gid: passwd -> gid = #gid
- val home: passwd -> string = #home
- val shell: passwd -> string = #shell
- end
-
- fun getpwnam name =
- let val name = NullString.nullTerm name
- in Passwd.fromC (fn () => Prim.getpwnam name)
- end
-
- fun getpwuid uid = Passwd.fromC (fn () => Prim.getpwuid uid)
-
- structure Group =
- struct
- type group = {name: string,
- gid: gid,
- members: string list}
-
- structure Group = Prim.Group
-
- fun fromC (f: unit -> bool): group =
- SysCall.syscall
- (fn () =>
- (if f () then 0 else ~1,
- fn () => {name = CS.toString(Group.getName ()),
- gid = Group.getGId (),
- members = COld.CSS.toList(Group.getMem ())}))
-
- val name: group -> string = #name
- val gid: group -> gid = #gid
- val members: group -> string list = #members
- end
-
- fun getgrnam name =
- let val name = NullString.nullTerm name
- in Group.fromC (fn () => Prim.getgrnam name)
- end
-
- fun getgrgid gid = Group.fromC (fn () => Prim.getgrgid gid)
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,283 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure PosixTTY: POSIX_TTY =
- struct
- structure Cstring = COld.CS
- structure Prim = PrimitiveFFI.Posix.TTY
- open Prim
- structure Error = PosixError
- structure SysCall = Error.SysCall
-
- type pid = C.PId.t
-
- type file_desc = C.Fd.t
-
- structure V =
- struct
- open V
- val nccs = NCCS
- val eof = VEOF
- val eol = VEOL
- val erase = VERASE
- val intr = VINTR
- val kill = VKILL
- val min = VMIN
- val quit = VQUIT
- val susp = VSUSP
- val time = VTIME
- val start = VSTART
- val stop = VSTOP
-
- type cc = C.CC.t array
-
- val default = Byte.charToByte #"\000"
-
- fun new () = Array.array (NCCS, default)
-
- fun updates (a, l) =
- List.app (fn (i, cc) => Array.update (a, i, Byte.charToByte cc)) l
-
- fun cc l = let val a = new ()
- in updates (a, l)
- ; a
- end
-
- fun update (a, l) =
- let val a' = new ()
- in Array.copy {src = a, dst = a', di = 0}
- ; updates (a', l)
- ; a'
- end
-
- val sub = Byte.byteToChar o Array.sub
- end
-
- structure IFlags =
- struct
- open IFlags BitFlags
- val brkint = BRKINT
- val icrnl = ICRNL
- val ignbrk = IGNBRK
- val igncr = IGNCR
- val ignpar = IGNPAR
- val inlcr = INLCR
- val inpck = INPCK
- val istrip = ISTRIP
- val ixany = IXANY
- val ixoff = IXOFF
- val ixon = IXON
- val parmrk = PARMRK
- end
-
- structure OFlags =
- struct
- open OFlags BitFlags
- val bs0 = BS0
- val bs1 = BS1
- val bsdly = BSDLY
- val cr0 = CR0
- val cr1 = CR1
- val cr2 = CR2
- val cr3 = CR3
- val crdly = CRDLY
- val ff0 = FF0
- val ff1 = FF1
- val ffdly = FFDLY
- val nl0 = NL0
- val nl1 = NL1
- val onldly = NLDLY
- val ocrnl = OCRNL
- val ofill = OFILL
- val onlcr = ONLCR
- val onlret = ONLRET
- val onocr = ONOCR
- val opost = OPOST
- val tab0 = TAB0
- val tab1 = TAB1
- val tab2 = TAB2
- val tab3 = TAB3
- val tabdly = TABDLY
- val vt0 = VT0
- val vt1 = VT1
- val vtdly = VTDLY
- end
-
- structure CFlags =
- struct
- open CFlags BitFlags
- val clocal = CLOCAL
- val cread = CREAD
- val cs5 = CS5
- val cs6 = CS6
- val cs7 = CS7
- val cs8 = CS8
- val csize = CSIZE
- val cstopb = CSTOPB
- val hupcl = HUPCL
- val parenb = PARENB
- val parodd = PARODD
- end
-
- structure LFlags =
- struct
- open LFlags BitFlags
- val echo = ECHO
- val echoe = ECHOE
- val echok = ECHOK
- val echonl = ECHONL
- val icanon = ICANON
- val iexten = IEXTEN
- val isig = ISIG
- val noflsh = NOFLSH
- val tostop = TOSTOP
- end
-
- type speed = C.Speed.t
-
- val b0 = B0
- val b110 = B110
- val b1200 = B1200
- val b134 = B134
- val b150 = B150
- val b1800 = B1800
- val b19200 = B19200
- val b200 = B200
- val b2400 = B2400
- val b300 = B300
- val b38400 = B38400
- val b4800 = B4800
- val b50 = B50
- val b600 = B600
- val b75 = B75
- val b9600 = B9600
-
- val compareSpeed = SysWord.compare
- fun id x = x
- val speedToWord = id
- val wordToSpeed = id
-
- type termios = {iflag: IFlags.flags,
- oflag: OFlags.flags,
- cflag: CFlags.flags,
- lflag: LFlags.flags,
- cc: V.cc,
- ispeed: speed,
- ospeed: speed}
-
- val termios = id
- val fieldsOf = id
-
- val getiflag: termios -> IFlags.flags = #iflag
- val getoflag: termios -> OFlags.flags = #oflag
- val getcflag: termios -> CFlags.flags = #cflag
- val getlflag: termios -> LFlags.flags = #oflag
- val getcc: termios -> V.cc = #cc
-
- structure CF =
- struct
- val getospeed: termios -> speed = #ospeed
- fun setospeed ({iflag, oflag, cflag, lflag, cc, ispeed, ...}: termios,
- ospeed: speed): termios =
- {iflag = iflag,
- oflag = oflag,
- cflag = cflag,
- lflag = lflag,
- cc = cc,
- ispeed = ispeed,
- ospeed = ospeed}
-
- val getispeed: termios -> speed = #ispeed
-
- fun setispeed ({iflag, oflag, cflag, lflag, cc, ospeed, ...}: termios,
- ispeed: speed): termios =
- {iflag = iflag,
- oflag = oflag,
- cflag = cflag,
- lflag = lflag,
- cc = cc,
- ispeed = ispeed,
- ospeed = ospeed}
- end
-
- structure Termios = Prim.Termios
-
- structure TC =
- struct
- open Prim.TC
-
- type set_action = C.Int.t
- val sadrain = TCSADRAIN
- val saflush = TCSAFLUSH
- val sanow = TCSANOW
-
- type flow_action = C.Int.t
- val ioff = TCIOFF
- val ion = TCION
- val ooff = TCOOFF
- val oon = TCOON
-
- type queue_sel = C.Int.t
- val iflush = TCIFLUSH
- val oflush = TCOFLUSH
- val ioflush = TCIOFLUSH
-
- fun getattr fd =
- SysCall.syscallRestart
- (fn () =>
- (Prim.TC.getattr fd, fn () =>
- {iflag = Termios.getIFlag (),
- oflag = Termios.getOFlag (),
- cflag = Termios.getCFlag (),
- lflag = Termios.getLFlag (),
- cc = let val a = V.new ()
- in Termios.getCC (a); a
- end,
- ispeed = Termios.cfGetISpeed (),
- ospeed = Termios.cfGetOSpeed ()}))
-
- fun setattr (fd, a,
- {iflag, oflag, cflag, lflag, cc, ispeed, ospeed}) =
- SysCall.syscallRestart
- (fn () =>
- (Termios.setIFlag iflag
- ; Termios.setOFlag oflag
- ; Termios.setCFlag cflag
- ; Termios.setLFlag lflag
- ; SysCall.simple (fn () => Termios.cfSetOSpeed ospeed)
- ; SysCall.simple (fn () => Termios.cfSetISpeed ispeed)
- ; Termios.setCC cc
- ; (Prim.TC.setattr (fd, a), fn () => ())))
-
- fun sendbreak (fd, n) =
- SysCall.simpleRestart (fn () => Prim.TC.sendbreak (fd, n))
-
- fun drain fd = SysCall.simpleRestart (fn () => Prim.TC.drain fd)
-
- fun flush (fd, n) =
- SysCall.simpleRestart (fn () => Prim.TC.flush (fd, n))
-
- fun flow (fd, n) =
- SysCall.simpleRestart (fn () => Prim.TC.flow (fd, n))
-
- fun getpgrp fd =
- SysCall.syscallRestart
- (fn () =>
- let val pid = Prim.TC.getpgrp fd
- in (Pid.toInt pid, fn () => pid)
- end)
-
- fun setpgrp (fd, pid) =
- SysCall.simpleRestart (fn () => Prim.TC.setpgrp (fd, pid))
- end
-
- structure C = CFlags
- structure I = IFlags
- structure L = LFlags
- structure O = OFlags
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,1000 +0,0 @@
-(* This file is automatically generated. Do not edit. *)
-
-structure PrimitiveFFI =
-struct
-structure CommandLine =
-struct
-val (argcGet, argcSet) = _symbol "CommandLine_argc": (unit -> (C.Int.t)) * ((C.Int.t) -> unit);
-val (argvGet, argvSet) = _symbol "CommandLine_argv": (unit -> (C.StringArray.t)) * ((C.StringArray.t) -> unit);
-val (commandNameGet, commandNameSet) = _symbol "CommandLine_commandName": (unit -> (C.String.t)) * ((C.String.t) -> unit);
-end
-structure Date =
-struct
-val gmTime = _import "Date_gmTime" : (C.Time.t) ref -> (C.Int.t) C.Errno.t;
-val localOffset = _import "Date_localOffset" : unit -> C.Double.t;
-val localTime = _import "Date_localTime" : (C.Time.t) ref -> (C.Int.t) C.Errno.t;
-val mkTime = _import "Date_mkTime" : unit -> (C.Time.t) C.Errno.t;
-val strfTime = _import "Date_strfTime" : (Char8.t) array * C.Size.t * NullString8.t -> C.Size.t;
-structure Tm =
-struct
-val getHour = _import "Date_Tm_getHour" : unit -> C.Int.t;
-val getIsDst = _import "Date_Tm_getIsDst" : unit -> C.Int.t;
-val getMDay = _import "Date_Tm_getMDay" : unit -> C.Int.t;
-val getMin = _import "Date_Tm_getMin" : unit -> C.Int.t;
-val getMon = _import "Date_Tm_getMon" : unit -> C.Int.t;
-val getSec = _import "Date_Tm_getSec" : unit -> C.Int.t;
-val getWDay = _import "Date_Tm_getWDay" : unit -> C.Int.t;
-val getYDay = _import "Date_Tm_getYDay" : unit -> C.Int.t;
-val getYear = _import "Date_Tm_getYear" : unit -> C.Int.t;
-val setHour = _import "Date_Tm_setHour" : C.Int.t -> unit;
-val setIsDst = _import "Date_Tm_setIsDst" : C.Int.t -> unit;
-val setMDay = _import "Date_Tm_setMDay" : C.Int.t -> unit;
-val setMin = _import "Date_Tm_setMin" : C.Int.t -> unit;
-val setMon = _import "Date_Tm_setMon" : C.Int.t -> unit;
-val setSec = _import "Date_Tm_setSec" : C.Int.t -> unit;
-val setWDay = _import "Date_Tm_setWDay" : C.Int.t -> unit;
-val setYDay = _import "Date_Tm_setYDay" : C.Int.t -> unit;
-val setYear = _import "Date_Tm_setYear" : C.Int.t -> unit;
-end
-end
-structure IEEEReal =
-struct
-val getRoundingMode = _import "IEEEReal_getRoundingMode" : unit -> C.Int.t;
-structure RoundingMode =
-struct
-val FE_DOWNWARD = _const "IEEEReal_RoundingMode_FE_DOWNWARD" : C.Int.t;
-val FE_NOSUPPORT = _const "IEEEReal_RoundingMode_FE_NOSUPPORT" : C.Int.t;
-val FE_TONEAREST = _const "IEEEReal_RoundingMode_FE_TONEAREST" : C.Int.t;
-val FE_TOWARDZERO = _const "IEEEReal_RoundingMode_FE_TOWARDZERO" : C.Int.t;
-val FE_UPWARD = _const "IEEEReal_RoundingMode_FE_UPWARD" : C.Int.t;
-end
-val setRoundingMode = _import "IEEEReal_setRoundingMode" : C.Int.t -> unit;
-end
-structure MLton =
-struct
-structure Itimer =
-struct
-val PROF = _const "MLton_Itimer_PROF" : C.Int.t;
-val REAL = _const "MLton_Itimer_REAL" : C.Int.t;
-val set = _import "MLton_Itimer_set" : C.Int.t * C.Time.t * C.SUSeconds.t * C.Time.t * C.SUSeconds.t -> (C.Int.t) C.Errno.t;
-val VIRTUAL = _const "MLton_Itimer_VIRTUAL" : C.Int.t;
-end
-structure Process =
-struct
-val cwait = _import "MLton_Process_cwait" : C.PId.t * (C.Status.t) ref -> (C.PId.t) C.Errno.t;
-val spawne = _import "MLton_Process_spawne" : NullString8.t * NullString8Array.t * NullString8Array.t -> (C.Int.t) C.Errno.t;
-val spawnp = _import "MLton_Process_spawnp" : NullString8.t * NullString8Array.t -> (C.Int.t) C.Errno.t;
-end
-structure Rlimit =
-struct
-val AS = _const "MLton_Rlimit_AS" : C.Int.t;
-val CORE = _const "MLton_Rlimit_CORE" : C.Int.t;
-val CPU = _const "MLton_Rlimit_CPU" : C.Int.t;
-val DATA = _const "MLton_Rlimit_DATA" : C.Int.t;
-val FSIZE = _const "MLton_Rlimit_FSIZE" : C.Int.t;
-val get = _import "MLton_Rlimit_get" : C.Int.t -> (C.Int.t) C.Errno.t;
-val getHard = _import "MLton_Rlimit_getHard" : unit -> C.RLim.t;
-val getSoft = _import "MLton_Rlimit_getSoft" : unit -> C.RLim.t;
-val INFINITY = _const "MLton_Rlimit_INFINITY" : C.RLim.t;
-val NOFILE = _const "MLton_Rlimit_NOFILE" : C.Int.t;
-val set = _import "MLton_Rlimit_set" : C.Int.t * C.RLim.t * C.RLim.t -> (C.Int.t) C.Errno.t;
-val STACK = _const "MLton_Rlimit_STACK" : C.Int.t;
-end
-structure Rusage =
-struct
-val children_stime_sec = _import "MLton_Rusage_children_stime_sec" : unit -> C.Time.t;
-val children_stime_usec = _import "MLton_Rusage_children_stime_usec" : unit -> C.SUSeconds.t;
-val children_utime_sec = _import "MLton_Rusage_children_utime_sec" : unit -> C.Time.t;
-val children_utime_usec = _import "MLton_Rusage_children_utime_usec" : unit -> C.SUSeconds.t;
-val gc_stime_sec = _import "MLton_Rusage_gc_stime_sec" : unit -> C.Time.t;
-val gc_stime_usec = _import "MLton_Rusage_gc_stime_usec" : unit -> C.SUSeconds.t;
-val gc_utime_sec = _import "MLton_Rusage_gc_utime_sec" : unit -> C.Time.t;
-val gc_utime_usec = _import "MLton_Rusage_gc_utime_usec" : unit -> C.SUSeconds.t;
-val getrusage = _import "MLton_Rusage_getrusage" : unit -> unit;
-val self_stime_sec = _import "MLton_Rusage_self_stime_sec" : unit -> C.Time.t;
-val self_stime_usec = _import "MLton_Rusage_self_stime_usec" : unit -> C.SUSeconds.t;
-val self_utime_sec = _import "MLton_Rusage_self_utime_sec" : unit -> C.Time.t;
-val self_utime_usec = _import "MLton_Rusage_self_utime_usec" : unit -> C.SUSeconds.t;
-end
-structure Syslog =
-struct
-val closelog = _import "MLton_Syslog_closelog" : unit -> unit;
-structure Facility =
-struct
-val LOG_AUTH = _const "MLton_Syslog_Facility_LOG_AUTH" : C.Int.t;
-val LOG_CRON = _const "MLton_Syslog_Facility_LOG_CRON" : C.Int.t;
-val LOG_DAEMON = _const "MLton_Syslog_Facility_LOG_DAEMON" : C.Int.t;
-val LOG_KERN = _const "MLton_Syslog_Facility_LOG_KERN" : C.Int.t;
-val LOG_LOCAL0 = _const "MLton_Syslog_Facility_LOG_LOCAL0" : C.Int.t;
-val LOG_LOCAL1 = _const "MLton_Syslog_Facility_LOG_LOCAL1" : C.Int.t;
-val LOG_LOCAL2 = _const "MLton_Syslog_Facility_LOG_LOCAL2" : C.Int.t;
-val LOG_LOCAL3 = _const "MLton_Syslog_Facility_LOG_LOCAL3" : C.Int.t;
-val LOG_LOCAL4 = _const "MLton_Syslog_Facility_LOG_LOCAL4" : C.Int.t;
-val LOG_LOCAL5 = _const "MLton_Syslog_Facility_LOG_LOCAL5" : C.Int.t;
-val LOG_LOCAL6 = _const "MLton_Syslog_Facility_LOG_LOCAL6" : C.Int.t;
-val LOG_LOCAL7 = _const "MLton_Syslog_Facility_LOG_LOCAL7" : C.Int.t;
-val LOG_LPR = _const "MLton_Syslog_Facility_LOG_LPR" : C.Int.t;
-val LOG_MAIL = _const "MLton_Syslog_Facility_LOG_MAIL" : C.Int.t;
-val LOG_NEWS = _const "MLton_Syslog_Facility_LOG_NEWS" : C.Int.t;
-val LOG_USER = _const "MLton_Syslog_Facility_LOG_USER" : C.Int.t;
-val LOG_UUCP = _const "MLton_Syslog_Facility_LOG_UUCP" : C.Int.t;
-end
-structure Logopt =
-struct
-val LOG_CONS = _const "MLton_Syslog_Logopt_LOG_CONS" : C.Int.t;
-val LOG_NDELAY = _const "MLton_Syslog_Logopt_LOG_NDELAY" : C.Int.t;
-val LOG_NOWAIT = _const "MLton_Syslog_Logopt_LOG_NOWAIT" : C.Int.t;
-val LOG_ODELAY = _const "MLton_Syslog_Logopt_LOG_ODELAY" : C.Int.t;
-val LOG_PID = _const "MLton_Syslog_Logopt_LOG_PID" : C.Int.t;
-end
-val openlog = _import "MLton_Syslog_openlog" : NullString8.t * C.Int.t * C.Int.t -> unit;
-structure Severity =
-struct
-val LOG_ALERT = _const "MLton_Syslog_Severity_LOG_ALERT" : C.Int.t;
-val LOG_CRIT = _const "MLton_Syslog_Severity_LOG_CRIT" : C.Int.t;
-val LOG_DEBUG = _const "MLton_Syslog_Severity_LOG_DEBUG" : C.Int.t;
-val LOG_EMERG = _const "MLton_Syslog_Severity_LOG_EMERG" : C.Int.t;
-val LOG_ERR = _const "MLton_Syslog_Severity_LOG_ERR" : C.Int.t;
-val LOG_INFO = _const "MLton_Syslog_Severity_LOG_INFO" : C.Int.t;
-val LOG_NOTICE = _const "MLton_Syslog_Severity_LOG_NOTICE" : C.Int.t;
-val LOG_WARNING = _const "MLton_Syslog_Severity_LOG_WARNING" : C.Int.t;
-end
-val syslog = _import "MLton_Syslog_syslog" : C.Int.t * NullString8.t -> unit;
-end
-end
-structure Net =
-struct
-val htonl = _import "Net_htonl" : Word32.t -> Word32.t;
-val htons = _import "Net_htons" : Word16.t -> Word16.t;
-val ntohl = _import "Net_ntohl" : Word32.t -> Word32.t;
-val ntohs = _import "Net_ntohs" : Word16.t -> Word16.t;
-end
-structure NetHostDB =
-struct
-val getByAddress = _import "NetHostDB_getByAddress" : (Word8.t) vector * C.Socklen.t -> Bool.t;
-val getByName = _import "NetHostDB_getByName" : NullString8.t -> Bool.t;
-val getEntryAddrsN = _import "NetHostDB_getEntryAddrsN" : C.Int.t * (Word8.t) array -> unit;
-val getEntryAddrsNum = _import "NetHostDB_getEntryAddrsNum" : unit -> C.Int.t;
-val getEntryAddrType = _import "NetHostDB_getEntryAddrType" : unit -> C.Int.t;
-val getEntryAliasesN = _import "NetHostDB_getEntryAliasesN" : C.Int.t -> C.String.t;
-val getEntryAliasesNum = _import "NetHostDB_getEntryAliasesNum" : unit -> C.Int.t;
-val getEntryLength = _import "NetHostDB_getEntryLength" : unit -> C.Int.t;
-val getEntryName = _import "NetHostDB_getEntryName" : unit -> C.String.t;
-val getHostName = _import "NetHostDB_getHostName" : (Char8.t) array * C.Size.t -> (C.Int.t) C.Errno.t;
-val INADDR_ANY = _const "NetHostDB_INADDR_ANY" : C.Int.t;
-val inAddrSize = _const "NetHostDB_inAddrSize" : C.Size.t;
-end
-structure NetProtDB =
-struct
-val getByName = _import "NetProtDB_getByName" : NullString8.t -> Bool.t;
-val getByNumber = _import "NetProtDB_getByNumber" : C.Int.t -> Bool.t;
-val getEntryAliasesN = _import "NetProtDB_getEntryAliasesN" : C.Int.t -> C.String.t;
-val getEntryAliasesNum = _import "NetProtDB_getEntryAliasesNum" : unit -> C.Int.t;
-val getEntryName = _import "NetProtDB_getEntryName" : unit -> C.String.t;
-val getEntryProto = _import "NetProtDB_getEntryProto" : unit -> C.Int.t;
-end
-structure NetServDB =
-struct
-val getByName = _import "NetServDB_getByName" : NullString8.t * NullString8.t -> Bool.t;
-val getByNameNull = _import "NetServDB_getByNameNull" : NullString8.t -> Bool.t;
-val getByPort = _import "NetServDB_getByPort" : C.Int.t * NullString8.t -> Bool.t;
-val getByPortNull = _import "NetServDB_getByPortNull" : C.Int.t -> Bool.t;
-val getEntryAliasesN = _import "NetServDB_getEntryAliasesN" : C.Int.t -> C.String.t;
-val getEntryAliasesNum = _import "NetServDB_getEntryAliasesNum" : unit -> C.Int.t;
-val getEntryName = _import "NetServDB_getEntryName" : unit -> C.String.t;
-val getEntryPort = _import "NetServDB_getEntryPort" : unit -> C.Int.t;
-val getEntryProto = _import "NetServDB_getEntryProto" : unit -> C.String.t;
-end
-structure OS =
-struct
-structure IO =
-struct
-val poll = _import "OS_IO_poll" : (C.Fd.t) vector * (C.Short.t) vector * C.NFds.t * C.Int.t * (C.Short.t) array -> (C.Int.t) C.Errno.t;
-val POLLIN = _const "OS_IO_POLLIN" : C.Short.t;
-val POLLOUT = _const "OS_IO_POLLOUT" : C.Short.t;
-val POLLPRI = _const "OS_IO_POLLPRI" : C.Short.t;
-end
-end
-structure Posix =
-struct
-structure Error =
-struct
-val clearErrno = _import "Posix_Error_clearErrno" : unit -> unit;
-val E2BIG = _const "Posix_Error_E2BIG" : C.Int.t;
-val EACCES = _const "Posix_Error_EACCES" : C.Int.t;
-val EADDRINUSE = _const "Posix_Error_EADDRINUSE" : C.Int.t;
-val EADDRNOTAVAIL = _const "Posix_Error_EADDRNOTAVAIL" : C.Int.t;
-val EAFNOSUPPORT = _const "Posix_Error_EAFNOSUPPORT" : C.Int.t;
-val EAGAIN = _const "Posix_Error_EAGAIN" : C.Int.t;
-val EALREADY = _const "Posix_Error_EALREADY" : C.Int.t;
-val EBADF = _const "Posix_Error_EBADF" : C.Int.t;
-val EBADMSG = _const "Posix_Error_EBADMSG" : C.Int.t;
-val EBUSY = _const "Posix_Error_EBUSY" : C.Int.t;
-val ECANCELED = _const "Posix_Error_ECANCELED" : C.Int.t;
-val ECHILD = _const "Posix_Error_ECHILD" : C.Int.t;
-val ECONNABORTED = _const "Posix_Error_ECONNABORTED" : C.Int.t;
-val ECONNREFUSED = _const "Posix_Error_ECONNREFUSED" : C.Int.t;
-val ECONNRESET = _const "Posix_Error_ECONNRESET" : C.Int.t;
-val EDEADLK = _const "Posix_Error_EDEADLK" : C.Int.t;
-val EDESTADDRREQ = _const "Posix_Error_EDESTADDRREQ" : C.Int.t;
-val EDOM = _const "Posix_Error_EDOM" : C.Int.t;
-val EDQUOT = _const "Posix_Error_EDQUOT" : C.Int.t;
-val EEXIST = _const "Posix_Error_EEXIST" : C.Int.t;
-val EFAULT = _const "Posix_Error_EFAULT" : C.Int.t;
-val EFBIG = _const "Posix_Error_EFBIG" : C.Int.t;
-val EHOSTUNREACH = _const "Posix_Error_EHOSTUNREACH" : C.Int.t;
-val EIDRM = _const "Posix_Error_EIDRM" : C.Int.t;
-val EILSEQ = _const "Posix_Error_EILSEQ" : C.Int.t;
-val EINPROGRESS = _const "Posix_Error_EINPROGRESS" : C.Int.t;
-val EINTR = _const "Posix_Error_EINTR" : C.Int.t;
-val EINVAL = _const "Posix_Error_EINVAL" : C.Int.t;
-val EIO = _const "Posix_Error_EIO" : C.Int.t;
-val EISCONN = _const "Posix_Error_EISCONN" : C.Int.t;
-val EISDIR = _const "Posix_Error_EISDIR" : C.Int.t;
-val ELOOP = _const "Posix_Error_ELOOP" : C.Int.t;
-val EMFILE = _const "Posix_Error_EMFILE" : C.Int.t;
-val EMLINK = _const "Posix_Error_EMLINK" : C.Int.t;
-val EMSGSIZE = _const "Posix_Error_EMSGSIZE" : C.Int.t;
-val EMULTIHOP = _const "Posix_Error_EMULTIHOP" : C.Int.t;
-val ENAMETOOLONG = _const "Posix_Error_ENAMETOOLONG" : C.Int.t;
-val ENETDOWN = _const "Posix_Error_ENETDOWN" : C.Int.t;
-val ENETRESET = _const "Posix_Error_ENETRESET" : C.Int.t;
-val ENETUNREACH = _const "Posix_Error_ENETUNREACH" : C.Int.t;
-val ENFILE = _const "Posix_Error_ENFILE" : C.Int.t;
-val ENOBUFS = _const "Posix_Error_ENOBUFS" : C.Int.t;
-val ENODATA = _const "Posix_Error_ENODATA" : C.Int.t;
-val ENODEV = _const "Posix_Error_ENODEV" : C.Int.t;
-val ENOENT = _const "Posix_Error_ENOENT" : C.Int.t;
-val ENOEXEC = _const "Posix_Error_ENOEXEC" : C.Int.t;
-val ENOLCK = _const "Posix_Error_ENOLCK" : C.Int.t;
-val ENOLINK = _const "Posix_Error_ENOLINK" : C.Int.t;
-val ENOMEM = _const "Posix_Error_ENOMEM" : C.Int.t;
-val ENOMSG = _const "Posix_Error_ENOMSG" : C.Int.t;
-val ENOPROTOOPT = _const "Posix_Error_ENOPROTOOPT" : C.Int.t;
-val ENOSPC = _const "Posix_Error_ENOSPC" : C.Int.t;
-val ENOSR = _const "Posix_Error_ENOSR" : C.Int.t;
-val ENOSTR = _const "Posix_Error_ENOSTR" : C.Int.t;
-val ENOSYS = _const "Posix_Error_ENOSYS" : C.Int.t;
-val ENOTCONN = _const "Posix_Error_ENOTCONN" : C.Int.t;
-val ENOTDIR = _const "Posix_Error_ENOTDIR" : C.Int.t;
-val ENOTEMPTY = _const "Posix_Error_ENOTEMPTY" : C.Int.t;
-val ENOTSOCK = _const "Posix_Error_ENOTSOCK" : C.Int.t;
-val ENOTSUP = _const "Posix_Error_ENOTSUP" : C.Int.t;
-val ENOTTY = _const "Posix_Error_ENOTTY" : C.Int.t;
-val ENXIO = _const "Posix_Error_ENXIO" : C.Int.t;
-val EOPNOTSUPP = _const "Posix_Error_EOPNOTSUPP" : C.Int.t;
-val EOVERFLOW = _const "Posix_Error_EOVERFLOW" : C.Int.t;
-val EPERM = _const "Posix_Error_EPERM" : C.Int.t;
-val EPIPE = _const "Posix_Error_EPIPE" : C.Int.t;
-val EPROTO = _const "Posix_Error_EPROTO" : C.Int.t;
-val EPROTONOSUPPORT = _const "Posix_Error_EPROTONOSUPPORT" : C.Int.t;
-val EPROTOTYPE = _const "Posix_Error_EPROTOTYPE" : C.Int.t;
-val ERANGE = _const "Posix_Error_ERANGE" : C.Int.t;
-val EROFS = _const "Posix_Error_EROFS" : C.Int.t;
-val ESPIPE = _const "Posix_Error_ESPIPE" : C.Int.t;
-val ESRCH = _const "Posix_Error_ESRCH" : C.Int.t;
-val ESTALE = _const "Posix_Error_ESTALE" : C.Int.t;
-val ETIME = _const "Posix_Error_ETIME" : C.Int.t;
-val ETIMEDOUT = _const "Posix_Error_ETIMEDOUT" : C.Int.t;
-val ETXTBSY = _const "Posix_Error_ETXTBSY" : C.Int.t;
-val EWOULDBLOCK = _const "Posix_Error_EWOULDBLOCK" : C.Int.t;
-val EXDEV = _const "Posix_Error_EXDEV" : C.Int.t;
-val getErrno = _import "Posix_Error_getErrno" : unit -> C.Int.t;
-val strError = _import "Posix_Error_strError" : C.Int.t -> C.String.t;
-end
-structure FileSys =
-struct
-structure A =
-struct
-val F_OK = _const "Posix_FileSys_A_F_OK" : C.Int.t;
-val R_OK = _const "Posix_FileSys_A_R_OK" : C.Int.t;
-val W_OK = _const "Posix_FileSys_A_W_OK" : C.Int.t;
-val X_OK = _const "Posix_FileSys_A_X_OK" : C.Int.t;
-end
-val access = _import "Posix_FileSys_access" : NullString8.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val chdir = _import "Posix_FileSys_chdir" : NullString8.t -> (C.Int.t) C.Errno.t;
-val chmod = _import "Posix_FileSys_chmod" : NullString8.t * C.Mode.t -> (C.Int.t) C.Errno.t;
-val chown = _import "Posix_FileSys_chown" : NullString8.t * C.UId.t * C.GId.t -> (C.Int.t) C.Errno.t;
-structure Dirstream =
-struct
-val closeDir = _import "Posix_FileSys_Dirstream_closeDir" : C.DirP.t -> (C.Int.t) C.Errno.t;
-val openDir = _import "Posix_FileSys_Dirstream_openDir" : NullString8.t -> (C.DirP.t) C.Errno.t;
-val readDir = _import "Posix_FileSys_Dirstream_readDir" : C.DirP.t -> (C.String.t) C.Errno.t;
-val rewindDir = _import "Posix_FileSys_Dirstream_rewindDir" : C.DirP.t -> unit;
-end
-val fchdir = _import "Posix_FileSys_fchdir" : C.Fd.t -> (C.Int.t) C.Errno.t;
-val fchmod = _import "Posix_FileSys_fchmod" : C.Fd.t * C.Mode.t -> (C.Int.t) C.Errno.t;
-val fchown = _import "Posix_FileSys_fchown" : C.Fd.t * C.UId.t * C.GId.t -> (C.Int.t) C.Errno.t;
-val fpathconf = _import "Posix_FileSys_fpathconf" : C.Fd.t * C.Int.t -> (C.Long.t) C.Errno.t;
-val ftruncate = _import "Posix_FileSys_ftruncate" : C.Fd.t * C.Off.t -> (C.Int.t) C.Errno.t;
-val getcwd = _import "Posix_FileSys_getcwd" : (Char8.t) array * C.Size.t -> (C.String.t) C.Errno.t;
-val link = _import "Posix_FileSys_link" : NullString8.t * NullString8.t -> (C.Int.t) C.Errno.t;
-val mkdir = _import "Posix_FileSys_mkdir" : NullString8.t * C.Mode.t -> (C.Int.t) C.Errno.t;
-val mkfifo = _import "Posix_FileSys_mkfifo" : NullString8.t * C.Mode.t -> (C.Int.t) C.Errno.t;
-structure O =
-struct
-val APPEND = _const "Posix_FileSys_O_APPEND" : C.Int.t;
-val BINARY = _const "Posix_FileSys_O_BINARY" : C.Int.t;
-val CREAT = _const "Posix_FileSys_O_CREAT" : C.Int.t;
-val DSYNC = _const "Posix_FileSys_O_DSYNC" : C.Int.t;
-val EXCL = _const "Posix_FileSys_O_EXCL" : C.Int.t;
-val NOCTTY = _const "Posix_FileSys_O_NOCTTY" : C.Int.t;
-val NONBLOCK = _const "Posix_FileSys_O_NONBLOCK" : C.Int.t;
-val RDONLY = _const "Posix_FileSys_O_RDONLY" : C.Int.t;
-val RDWR = _const "Posix_FileSys_O_RDWR" : C.Int.t;
-val RSYNC = _const "Posix_FileSys_O_RSYNC" : C.Int.t;
-val SYNC = _const "Posix_FileSys_O_SYNC" : C.Int.t;
-val TEXT = _const "Posix_FileSys_O_TEXT" : C.Int.t;
-val TRUNC = _const "Posix_FileSys_O_TRUNC" : C.Int.t;
-val WRONLY = _const "Posix_FileSys_O_WRONLY" : C.Int.t;
-end
-val open2 = _import "Posix_FileSys_open2" : NullString8.t * C.Int.t -> (C.Fd.t) C.Errno.t;
-val open3 = _import "Posix_FileSys_open3" : NullString8.t * C.Int.t * C.Mode.t -> (C.Fd.t) C.Errno.t;
-val pathconf = _import "Posix_FileSys_pathconf" : NullString8.t * C.Int.t -> (C.Long.t) C.Errno.t;
-structure PC =
-struct
-val ALLOC_SIZE_MIN = _const "Posix_FileSys_PC_ALLOC_SIZE_MIN" : C.Int.t;
-val ASYNC_IO = _const "Posix_FileSys_PC_ASYNC_IO" : C.Int.t;
-val CHOWN_RESTRICTED = _const "Posix_FileSys_PC_CHOWN_RESTRICTED" : C.Int.t;
-val FILESIZEBITS = _const "Posix_FileSys_PC_FILESIZEBITS" : C.Int.t;
-val LINK_MAX = _const "Posix_FileSys_PC_LINK_MAX" : C.Int.t;
-val MAX_CANON = _const "Posix_FileSys_PC_MAX_CANON" : C.Int.t;
-val MAX_INPUT = _const "Posix_FileSys_PC_MAX_INPUT" : C.Int.t;
-val NAME_MAX = _const "Posix_FileSys_PC_NAME_MAX" : C.Int.t;
-val NO_TRUNC = _const "Posix_FileSys_PC_NO_TRUNC" : C.Int.t;
-val PATH_MAX = _const "Posix_FileSys_PC_PATH_MAX" : C.Int.t;
-val PIPE_BUF = _const "Posix_FileSys_PC_PIPE_BUF" : C.Int.t;
-val PRIO_IO = _const "Posix_FileSys_PC_PRIO_IO" : C.Int.t;
-val REC_INCR_XFER_SIZE = _const "Posix_FileSys_PC_REC_INCR_XFER_SIZE" : C.Int.t;
-val REC_MAX_XFER_SIZE = _const "Posix_FileSys_PC_REC_MAX_XFER_SIZE" : C.Int.t;
-val REC_MIN_XFER_SIZE = _const "Posix_FileSys_PC_REC_MIN_XFER_SIZE" : C.Int.t;
-val REC_XFER_ALIGN = _const "Posix_FileSys_PC_REC_XFER_ALIGN" : C.Int.t;
-val SYMLINK_MAX = _const "Posix_FileSys_PC_SYMLINK_MAX" : C.Int.t;
-val SYNC_IO = _const "Posix_FileSys_PC_SYNC_IO" : C.Int.t;
-val VDISABLE = _const "Posix_FileSys_PC_VDISABLE" : C.Int.t;
-end
-val readlink = _import "Posix_FileSys_readlink" : NullString8.t * (Char8.t) array * C.Size.t -> (C.SSize.t) C.Errno.t;
-val rename = _import "Posix_FileSys_rename" : NullString8.t * NullString8.t -> (C.Int.t) C.Errno.t;
-val rmdir = _import "Posix_FileSys_rmdir" : NullString8.t -> (C.Int.t) C.Errno.t;
-structure S =
-struct
-val IFBLK = _const "Posix_FileSys_S_IFBLK" : C.Mode.t;
-val IFCHR = _const "Posix_FileSys_S_IFCHR" : C.Mode.t;
-val IFDIR = _const "Posix_FileSys_S_IFDIR" : C.Mode.t;
-val IFIFO = _const "Posix_FileSys_S_IFIFO" : C.Mode.t;
-val IFLNK = _const "Posix_FileSys_S_IFLNK" : C.Mode.t;
-val IFMT = _const "Posix_FileSys_S_IFMT" : C.Mode.t;
-val IFREG = _const "Posix_FileSys_S_IFREG" : C.Mode.t;
-val IFSOCK = _const "Posix_FileSys_S_IFSOCK" : C.Mode.t;
-val IRGRP = _const "Posix_FileSys_S_IRGRP" : C.Mode.t;
-val IROTH = _const "Posix_FileSys_S_IROTH" : C.Mode.t;
-val IRUSR = _const "Posix_FileSys_S_IRUSR" : C.Mode.t;
-val IRWXG = _const "Posix_FileSys_S_IRWXG" : C.Mode.t;
-val IRWXO = _const "Posix_FileSys_S_IRWXO" : C.Mode.t;
-val IRWXU = _const "Posix_FileSys_S_IRWXU" : C.Mode.t;
-val ISGID = _const "Posix_FileSys_S_ISGID" : C.Mode.t;
-val ISUID = _const "Posix_FileSys_S_ISUID" : C.Mode.t;
-val ISVTX = _const "Posix_FileSys_S_ISVTX" : C.Mode.t;
-val IWGRP = _const "Posix_FileSys_S_IWGRP" : C.Mode.t;
-val IWOTH = _const "Posix_FileSys_S_IWOTH" : C.Mode.t;
-val IWUSR = _const "Posix_FileSys_S_IWUSR" : C.Mode.t;
-val IXGRP = _const "Posix_FileSys_S_IXGRP" : C.Mode.t;
-val IXOTH = _const "Posix_FileSys_S_IXOTH" : C.Mode.t;
-val IXUSR = _const "Posix_FileSys_S_IXUSR" : C.Mode.t;
-end
-structure ST =
-struct
-val isBlk = _import "Posix_FileSys_ST_isBlk" : C.Mode.t -> Bool.t;
-val isChr = _import "Posix_FileSys_ST_isChr" : C.Mode.t -> Bool.t;
-val isDir = _import "Posix_FileSys_ST_isDir" : C.Mode.t -> Bool.t;
-val isFIFO = _import "Posix_FileSys_ST_isFIFO" : C.Mode.t -> Bool.t;
-val isLink = _import "Posix_FileSys_ST_isLink" : C.Mode.t -> Bool.t;
-val isReg = _import "Posix_FileSys_ST_isReg" : C.Mode.t -> Bool.t;
-val isSock = _import "Posix_FileSys_ST_isSock" : C.Mode.t -> Bool.t;
-end
-structure Stat =
-struct
-val fstat = _import "Posix_FileSys_Stat_fstat" : C.Fd.t -> (C.Int.t) C.Errno.t;
-val getATime = _import "Posix_FileSys_Stat_getATime" : unit -> C.Time.t;
-val getCTime = _import "Posix_FileSys_Stat_getCTime" : unit -> C.Time.t;
-val getDev = _import "Posix_FileSys_Stat_getDev" : unit -> C.Dev.t;
-val getGId = _import "Posix_FileSys_Stat_getGId" : unit -> C.GId.t;
-val getINo = _import "Posix_FileSys_Stat_getINo" : unit -> C.INo.t;
-val getMode = _import "Posix_FileSys_Stat_getMode" : unit -> C.Mode.t;
-val getMTime = _import "Posix_FileSys_Stat_getMTime" : unit -> C.Time.t;
-val getNLink = _import "Posix_FileSys_Stat_getNLink" : unit -> C.NLink.t;
-val getRDev = _import "Posix_FileSys_Stat_getRDev" : unit -> C.Dev.t;
-val getSize = _import "Posix_FileSys_Stat_getSize" : unit -> C.Off.t;
-val getUId = _import "Posix_FileSys_Stat_getUId" : unit -> C.UId.t;
-val lstat = _import "Posix_FileSys_Stat_lstat" : NullString8.t -> (C.Int.t) C.Errno.t;
-val stat = _import "Posix_FileSys_Stat_stat" : NullString8.t -> (C.Int.t) C.Errno.t;
-end
-val symlink = _import "Posix_FileSys_symlink" : NullString8.t * NullString8.t -> (C.Int.t) C.Errno.t;
-val truncate = _import "Posix_FileSys_truncate" : NullString8.t * C.Off.t -> (C.Int.t) C.Errno.t;
-val umask = _import "Posix_FileSys_umask" : C.Mode.t -> C.Mode.t;
-val unlink = _import "Posix_FileSys_unlink" : NullString8.t -> (C.Int.t) C.Errno.t;
-structure Utimbuf =
-struct
-val setAcTime = _import "Posix_FileSys_Utimbuf_setAcTime" : C.Time.t -> unit;
-val setModTime = _import "Posix_FileSys_Utimbuf_setModTime" : C.Time.t -> unit;
-val utime = _import "Posix_FileSys_Utimbuf_utime" : NullString8.t -> (C.Int.t) C.Errno.t;
-end
-end
-structure IO =
-struct
-val close = _import "Posix_IO_close" : C.Fd.t -> (C.Int.t) C.Errno.t;
-val dup = _import "Posix_IO_dup" : C.Fd.t -> (C.Fd.t) C.Errno.t;
-val dup2 = _import "Posix_IO_dup2" : C.Fd.t * C.Fd.t -> (C.Fd.t) C.Errno.t;
-val F_DUPFD = _const "Posix_IO_F_DUPFD" : C.Int.t;
-val F_GETFD = _const "Posix_IO_F_GETFD" : C.Int.t;
-val F_GETFL = _const "Posix_IO_F_GETFL" : C.Int.t;
-val F_GETOWN = _const "Posix_IO_F_GETOWN" : C.Int.t;
-val F_SETFD = _const "Posix_IO_F_SETFD" : C.Int.t;
-val F_SETFL = _const "Posix_IO_F_SETFL" : C.Int.t;
-val F_SETOWN = _const "Posix_IO_F_SETOWN" : C.Int.t;
-val fcntl2 = _import "Posix_IO_fcntl2" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val fcntl3 = _import "Posix_IO_fcntl3" : C.Fd.t * C.Int.t * C.Int.t -> (C.Int.t) C.Errno.t;
-structure FD =
-struct
-val CLOEXEC = _const "Posix_IO_FD_CLOEXEC" : C.Fd.t;
-end
-structure FLock =
-struct
-val F_GETLK = _const "Posix_IO_FLock_F_GETLK" : C.Int.t;
-val F_RDLCK = _const "Posix_IO_FLock_F_RDLCK" : C.Short.t;
-val F_SETLK = _const "Posix_IO_FLock_F_SETLK" : C.Int.t;
-val F_SETLKW = _const "Posix_IO_FLock_F_SETLKW" : C.Int.t;
-val F_UNLCK = _const "Posix_IO_FLock_F_UNLCK" : C.Short.t;
-val F_WRLCK = _const "Posix_IO_FLock_F_WRLCK" : C.Short.t;
-val fcntl = _import "Posix_IO_FLock_fcntl" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val getLen = _import "Posix_IO_FLock_getLen" : unit -> C.Off.t;
-val getPId = _import "Posix_IO_FLock_getPId" : unit -> C.PId.t;
-val getStart = _import "Posix_IO_FLock_getStart" : unit -> C.Off.t;
-val getType = _import "Posix_IO_FLock_getType" : unit -> C.Short.t;
-val getWhence = _import "Posix_IO_FLock_getWhence" : unit -> C.Short.t;
-val SEEK_CUR = _const "Posix_IO_FLock_SEEK_CUR" : C.Short.t;
-val SEEK_END = _const "Posix_IO_FLock_SEEK_END" : C.Short.t;
-val SEEK_SET = _const "Posix_IO_FLock_SEEK_SET" : C.Short.t;
-val setLen = _import "Posix_IO_FLock_setLen" : C.Off.t -> unit;
-val setPId = _import "Posix_IO_FLock_setPId" : C.PId.t -> unit;
-val setStart = _import "Posix_IO_FLock_setStart" : C.Off.t -> unit;
-val setType = _import "Posix_IO_FLock_setType" : C.Short.t -> unit;
-val setWhence = _import "Posix_IO_FLock_setWhence" : C.Short.t -> unit;
-end
-val fsync = _import "Posix_IO_fsync" : C.Fd.t -> (C.Int.t) C.Errno.t;
-val lseek = _import "Posix_IO_lseek" : C.Fd.t * C.Off.t * C.Int.t -> (C.Off.t) C.Errno.t;
-val O_ACCMODE = _const "Posix_IO_O_ACCMODE" : C.Int.t;
-val pipe = _import "Posix_IO_pipe" : (C.Fd.t) array -> (C.Int.t) C.Errno.t;
-val readChar8 = _import "Posix_IO_readChar8" : C.Fd.t * (Char8.t) array * C.Int.t * C.Size.t -> (C.SSize.t) C.Errno.t;
-val readWord8 = _import "Posix_IO_readWord8" : C.Fd.t * (Word8.t) array * C.Int.t * C.Size.t -> (C.SSize.t) C.Errno.t;
-val SEEK_CUR = _const "Posix_IO_SEEK_CUR" : C.Int.t;
-val SEEK_END = _const "Posix_IO_SEEK_END" : C.Int.t;
-val SEEK_SET = _const "Posix_IO_SEEK_SET" : C.Int.t;
-val setbin = _import "Posix_IO_setbin" : C.Fd.t -> unit;
-val settext = _import "Posix_IO_settext" : C.Fd.t -> unit;
-val writeChar8Arr = _import "Posix_IO_writeChar8Arr" : C.Fd.t * (Char8.t) array * C.Int.t * C.Size.t -> (C.SSize.t) C.Errno.t;
-val writeChar8Vec = _import "Posix_IO_writeChar8Vec" : C.Fd.t * (Char8.t) vector * C.Int.t * C.Size.t -> (C.SSize.t) C.Errno.t;
-val writeWord8Arr = _import "Posix_IO_writeWord8Arr" : C.Fd.t * (Word8.t) array * C.Int.t * C.Size.t -> (C.SSize.t) C.Errno.t;
-val writeWord8Vec = _import "Posix_IO_writeWord8Vec" : C.Fd.t * (Word8.t) vector * C.Int.t * C.Size.t -> (C.SSize.t) C.Errno.t;
-end
-structure ProcEnv =
-struct
-val ctermid = _import "Posix_ProcEnv_ctermid" : unit -> C.String.t;
-val (environGet, environSet) = _symbol "Posix_ProcEnv_environ": (unit -> (C.StringArray.t)) * ((C.StringArray.t) -> unit);
-val getegid = _import "Posix_ProcEnv_getegid" : unit -> C.GId.t;
-val getenv = _import "Posix_ProcEnv_getenv" : NullString8.t -> C.String.t;
-val geteuid = _import "Posix_ProcEnv_geteuid" : unit -> C.UId.t;
-val getgid = _import "Posix_ProcEnv_getgid" : unit -> C.GId.t;
-val getgroups = _import "Posix_ProcEnv_getgroups" : C.Int.t * (C.GId.t) array -> (C.Int.t) C.Errno.t;
-val getgroupsN = _import "Posix_ProcEnv_getgroupsN" : unit -> C.Int.t;
-val getlogin = _import "Posix_ProcEnv_getlogin" : unit -> (C.String.t) C.Errno.t;
-val getpgrp = _import "Posix_ProcEnv_getpgrp" : unit -> C.PId.t;
-val getpid = _import "Posix_ProcEnv_getpid" : unit -> C.PId.t;
-val getppid = _import "Posix_ProcEnv_getppid" : unit -> C.PId.t;
-val getuid = _import "Posix_ProcEnv_getuid" : unit -> C.UId.t;
-val isatty = _import "Posix_ProcEnv_isatty" : C.Fd.t -> Bool.t;
-val SC_2_C_BIND = _const "Posix_ProcEnv_SC_2_C_BIND" : C.Int.t;
-val SC_2_C_DEV = _const "Posix_ProcEnv_SC_2_C_DEV" : C.Int.t;
-val SC_2_CHAR_TERM = _const "Posix_ProcEnv_SC_2_CHAR_TERM" : C.Int.t;
-val SC_2_FORT_DEV = _const "Posix_ProcEnv_SC_2_FORT_DEV" : C.Int.t;
-val SC_2_FORT_RUN = _const "Posix_ProcEnv_SC_2_FORT_RUN" : C.Int.t;
-val SC_2_LOCALEDEF = _const "Posix_ProcEnv_SC_2_LOCALEDEF" : C.Int.t;
-val SC_2_PBS = _const "Posix_ProcEnv_SC_2_PBS" : C.Int.t;
-val SC_2_PBS_ACCOUNTING = _const "Posix_ProcEnv_SC_2_PBS_ACCOUNTING" : C.Int.t;
-val SC_2_PBS_CHECKPOINT = _const "Posix_ProcEnv_SC_2_PBS_CHECKPOINT" : C.Int.t;
-val SC_2_PBS_LOCATE = _const "Posix_ProcEnv_SC_2_PBS_LOCATE" : C.Int.t;
-val SC_2_PBS_MESSAGE = _const "Posix_ProcEnv_SC_2_PBS_MESSAGE" : C.Int.t;
-val SC_2_PBS_TRACK = _const "Posix_ProcEnv_SC_2_PBS_TRACK" : C.Int.t;
-val SC_2_SW_DEV = _const "Posix_ProcEnv_SC_2_SW_DEV" : C.Int.t;
-val SC_2_UPE = _const "Posix_ProcEnv_SC_2_UPE" : C.Int.t;
-val SC_2_VERSION = _const "Posix_ProcEnv_SC_2_VERSION" : C.Int.t;
-val SC_ADVISORY_INFO = _const "Posix_ProcEnv_SC_ADVISORY_INFO" : C.Int.t;
-val SC_AIO_LISTIO_MAX = _const "Posix_ProcEnv_SC_AIO_LISTIO_MAX" : C.Int.t;
-val SC_AIO_MAX = _const "Posix_ProcEnv_SC_AIO_MAX" : C.Int.t;
-val SC_AIO_PRIO_DELTA_MAX = _const "Posix_ProcEnv_SC_AIO_PRIO_DELTA_MAX" : C.Int.t;
-val SC_ARG_MAX = _const "Posix_ProcEnv_SC_ARG_MAX" : C.Int.t;
-val SC_ASYNCHRONOUS_IO = _const "Posix_ProcEnv_SC_ASYNCHRONOUS_IO" : C.Int.t;
-val SC_ATEXIT_MAX = _const "Posix_ProcEnv_SC_ATEXIT_MAX" : C.Int.t;
-val SC_BARRIERS = _const "Posix_ProcEnv_SC_BARRIERS" : C.Int.t;
-val SC_BC_BASE_MAX = _const "Posix_ProcEnv_SC_BC_BASE_MAX" : C.Int.t;
-val SC_BC_DIM_MAX = _const "Posix_ProcEnv_SC_BC_DIM_MAX" : C.Int.t;
-val SC_BC_SCALE_MAX = _const "Posix_ProcEnv_SC_BC_SCALE_MAX" : C.Int.t;
-val SC_BC_STRING_MAX = _const "Posix_ProcEnv_SC_BC_STRING_MAX" : C.Int.t;
-val SC_CHILD_MAX = _const "Posix_ProcEnv_SC_CHILD_MAX" : C.Int.t;
-val SC_CLK_TCK = _const "Posix_ProcEnv_SC_CLK_TCK" : C.Int.t;
-val SC_CLOCK_SELECTION = _const "Posix_ProcEnv_SC_CLOCK_SELECTION" : C.Int.t;
-val SC_COLL_WEIGHTS_MAX = _const "Posix_ProcEnv_SC_COLL_WEIGHTS_MAX" : C.Int.t;
-val SC_CPUTIME = _const "Posix_ProcEnv_SC_CPUTIME" : C.Int.t;
-val SC_DELAYTIMER_MAX = _const "Posix_ProcEnv_SC_DELAYTIMER_MAX" : C.Int.t;
-val SC_EXPR_NEST_MAX = _const "Posix_ProcEnv_SC_EXPR_NEST_MAX" : C.Int.t;
-val SC_FSYNC = _const "Posix_ProcEnv_SC_FSYNC" : C.Int.t;
-val SC_GETGR_R_SIZE_MAX = _const "Posix_ProcEnv_SC_GETGR_R_SIZE_MAX" : C.Int.t;
-val SC_GETPW_R_SIZE_MAX = _const "Posix_ProcEnv_SC_GETPW_R_SIZE_MAX" : C.Int.t;
-val SC_HOST_NAME_MAX = _const "Posix_ProcEnv_SC_HOST_NAME_MAX" : C.Int.t;
-val SC_IOV_MAX = _const "Posix_ProcEnv_SC_IOV_MAX" : C.Int.t;
-val SC_IPV6 = _const "Posix_ProcEnv_SC_IPV6" : C.Int.t;
-val SC_JOB_CONTROL = _const "Posix_ProcEnv_SC_JOB_CONTROL" : C.Int.t;
-val SC_LINE_MAX = _const "Posix_ProcEnv_SC_LINE_MAX" : C.Int.t;
-val SC_LOGIN_NAME_MAX = _const "Posix_ProcEnv_SC_LOGIN_NAME_MAX" : C.Int.t;
-val SC_MAPPED_FILES = _const "Posix_ProcEnv_SC_MAPPED_FILES" : C.Int.t;
-val SC_MEMLOCK = _const "Posix_ProcEnv_SC_MEMLOCK" : C.Int.t;
-val SC_MEMLOCK_RANGE = _const "Posix_ProcEnv_SC_MEMLOCK_RANGE" : C.Int.t;
-val SC_MEMORY_PROTECTION = _const "Posix_ProcEnv_SC_MEMORY_PROTECTION" : C.Int.t;
-val SC_MESSAGE_PASSING = _const "Posix_ProcEnv_SC_MESSAGE_PASSING" : C.Int.t;
-val SC_MONOTONIC_CLOCK = _const "Posix_ProcEnv_SC_MONOTONIC_CLOCK" : C.Int.t;
-val SC_MQ_OPEN_MAX = _const "Posix_ProcEnv_SC_MQ_OPEN_MAX" : C.Int.t;
-val SC_MQ_PRIO_MAX = _const "Posix_ProcEnv_SC_MQ_PRIO_MAX" : C.Int.t;
-val SC_NGROUPS_MAX = _const "Posix_ProcEnv_SC_NGROUPS_MAX" : C.Int.t;
-val SC_OPEN_MAX = _const "Posix_ProcEnv_SC_OPEN_MAX" : C.Int.t;
-val SC_PAGE_SIZE = _const "Posix_ProcEnv_SC_PAGE_SIZE" : C.Int.t;
-val SC_PAGESIZE = _const "Posix_ProcEnv_SC_PAGESIZE" : C.Int.t;
-val SC_PRIORITIZED_IO = _const "Posix_ProcEnv_SC_PRIORITIZED_IO" : C.Int.t;
-val SC_PRIORITY_SCHEDULING = _const "Posix_ProcEnv_SC_PRIORITY_SCHEDULING" : C.Int.t;
-val SC_RAW_SOCKETS = _const "Posix_ProcEnv_SC_RAW_SOCKETS" : C.Int.t;
-val SC_RE_DUP_MAX = _const "Posix_ProcEnv_SC_RE_DUP_MAX" : C.Int.t;
-val SC_READER_WRITER_LOCKS = _const "Posix_ProcEnv_SC_READER_WRITER_LOCKS" : C.Int.t;
-val SC_REALTIME_SIGNALS = _const "Posix_ProcEnv_SC_REALTIME_SIGNALS" : C.Int.t;
-val SC_REGEXP = _const "Posix_ProcEnv_SC_REGEXP" : C.Int.t;
-val SC_RTSIG_MAX = _const "Posix_ProcEnv_SC_RTSIG_MAX" : C.Int.t;
-val SC_SAVED_IDS = _const "Posix_ProcEnv_SC_SAVED_IDS" : C.Int.t;
-val SC_SEM_NSEMS_MAX = _const "Posix_ProcEnv_SC_SEM_NSEMS_MAX" : C.Int.t;
-val SC_SEM_VALUE_MAX = _const "Posix_ProcEnv_SC_SEM_VALUE_MAX" : C.Int.t;
-val SC_SEMAPHORES = _const "Posix_ProcEnv_SC_SEMAPHORES" : C.Int.t;
-val SC_SHARED_MEMORY_OBJECTS = _const "Posix_ProcEnv_SC_SHARED_MEMORY_OBJECTS" : C.Int.t;
-val SC_SHELL = _const "Posix_ProcEnv_SC_SHELL" : C.Int.t;
-val SC_SIGQUEUE_MAX = _const "Posix_ProcEnv_SC_SIGQUEUE_MAX" : C.Int.t;
-val SC_SPAWN = _const "Posix_ProcEnv_SC_SPAWN" : C.Int.t;
-val SC_SPIN_LOCKS = _const "Posix_ProcEnv_SC_SPIN_LOCKS" : C.Int.t;
-val SC_SPORADIC_SERVER = _const "Posix_ProcEnv_SC_SPORADIC_SERVER" : C.Int.t;
-val SC_SS_REPL_MAX = _const "Posix_ProcEnv_SC_SS_REPL_MAX" : C.Int.t;
-val SC_STREAM_MAX = _const "Posix_ProcEnv_SC_STREAM_MAX" : C.Int.t;
-val SC_SYMLOOP_MAX = _const "Posix_ProcEnv_SC_SYMLOOP_MAX" : C.Int.t;
-val SC_SYNCHRONIZED_IO = _const "Posix_ProcEnv_SC_SYNCHRONIZED_IO" : C.Int.t;
-val SC_THREAD_ATTR_STACKADDR = _const "Posix_ProcEnv_SC_THREAD_ATTR_STACKADDR" : C.Int.t;
-val SC_THREAD_ATTR_STACKSIZE = _const "Posix_ProcEnv_SC_THREAD_ATTR_STACKSIZE" : C.Int.t;
-val SC_THREAD_CPUTIME = _const "Posix_ProcEnv_SC_THREAD_CPUTIME" : C.Int.t;
-val SC_THREAD_DESTRUCTOR_ITERATIONS = _const "Posix_ProcEnv_SC_THREAD_DESTRUCTOR_ITERATIONS" : C.Int.t;
-val SC_THREAD_KEYS_MAX = _const "Posix_ProcEnv_SC_THREAD_KEYS_MAX" : C.Int.t;
-val SC_THREAD_PRIO_INHERIT = _const "Posix_ProcEnv_SC_THREAD_PRIO_INHERIT" : C.Int.t;
-val SC_THREAD_PRIO_PROTECT = _const "Posix_ProcEnv_SC_THREAD_PRIO_PROTECT" : C.Int.t;
-val SC_THREAD_PRIORITY_SCHEDULING = _const "Posix_ProcEnv_SC_THREAD_PRIORITY_SCHEDULING" : C.Int.t;
-val SC_THREAD_PROCESS_SHARED = _const "Posix_ProcEnv_SC_THREAD_PROCESS_SHARED" : C.Int.t;
-val SC_THREAD_SAFE_FUNCTIONS = _const "Posix_ProcEnv_SC_THREAD_SAFE_FUNCTIONS" : C.Int.t;
-val SC_THREAD_SPORADIC_SERVER = _const "Posix_ProcEnv_SC_THREAD_SPORADIC_SERVER" : C.Int.t;
-val SC_THREAD_STACK_MIN = _const "Posix_ProcEnv_SC_THREAD_STACK_MIN" : C.Int.t;
-val SC_THREAD_THREADS_MAX = _const "Posix_ProcEnv_SC_THREAD_THREADS_MAX" : C.Int.t;
-val SC_THREADS = _const "Posix_ProcEnv_SC_THREADS" : C.Int.t;
-val SC_TIMEOUTS = _const "Posix_ProcEnv_SC_TIMEOUTS" : C.Int.t;
-val SC_TIMER_MAX = _const "Posix_ProcEnv_SC_TIMER_MAX" : C.Int.t;
-val SC_TIMERS = _const "Posix_ProcEnv_SC_TIMERS" : C.Int.t;
-val SC_TRACE = _const "Posix_ProcEnv_SC_TRACE" : C.Int.t;
-val SC_TRACE_EVENT_FILTER = _const "Posix_ProcEnv_SC_TRACE_EVENT_FILTER" : C.Int.t;
-val SC_TRACE_EVENT_NAME_MAX = _const "Posix_ProcEnv_SC_TRACE_EVENT_NAME_MAX" : C.Int.t;
-val SC_TRACE_INHERIT = _const "Posix_ProcEnv_SC_TRACE_INHERIT" : C.Int.t;
-val SC_TRACE_LOG = _const "Posix_ProcEnv_SC_TRACE_LOG" : C.Int.t;
-val SC_TRACE_NAME_MAX = _const "Posix_ProcEnv_SC_TRACE_NAME_MAX" : C.Int.t;
-val SC_TRACE_SYS_MAX = _const "Posix_ProcEnv_SC_TRACE_SYS_MAX" : C.Int.t;
-val SC_TRACE_USER_EVENT_MAX = _const "Posix_ProcEnv_SC_TRACE_USER_EVENT_MAX" : C.Int.t;
-val SC_TTY_NAME_MAX = _const "Posix_ProcEnv_SC_TTY_NAME_MAX" : C.Int.t;
-val SC_TYPED_MEMORY_OBJECTS = _const "Posix_ProcEnv_SC_TYPED_MEMORY_OBJECTS" : C.Int.t;
-val SC_TZNAME_MAX = _const "Posix_ProcEnv_SC_TZNAME_MAX" : C.Int.t;
-val SC_V6_ILP32_OFF32 = _const "Posix_ProcEnv_SC_V6_ILP32_OFF32" : C.Int.t;
-val SC_V6_ILP32_OFFBIG = _const "Posix_ProcEnv_SC_V6_ILP32_OFFBIG" : C.Int.t;
-val SC_V6_LP64_OFF64 = _const "Posix_ProcEnv_SC_V6_LP64_OFF64" : C.Int.t;
-val SC_V6_LPBIG_OFFBIG = _const "Posix_ProcEnv_SC_V6_LPBIG_OFFBIG" : C.Int.t;
-val SC_VERSION = _const "Posix_ProcEnv_SC_VERSION" : C.Int.t;
-val SC_XBS5_ILP32_OFF32 = _const "Posix_ProcEnv_SC_XBS5_ILP32_OFF32" : C.Int.t;
-val SC_XBS5_ILP32_OFFBIG = _const "Posix_ProcEnv_SC_XBS5_ILP32_OFFBIG" : C.Int.t;
-val SC_XBS5_LP64_OFF64 = _const "Posix_ProcEnv_SC_XBS5_LP64_OFF64" : C.Int.t;
-val SC_XBS5_LPBIG_OFFBIG = _const "Posix_ProcEnv_SC_XBS5_LPBIG_OFFBIG" : C.Int.t;
-val SC_XOPEN_CRYPT = _const "Posix_ProcEnv_SC_XOPEN_CRYPT" : C.Int.t;
-val SC_XOPEN_ENH_I18N = _const "Posix_ProcEnv_SC_XOPEN_ENH_I18N" : C.Int.t;
-val SC_XOPEN_LEGACY = _const "Posix_ProcEnv_SC_XOPEN_LEGACY" : C.Int.t;
-val SC_XOPEN_REALTIME = _const "Posix_ProcEnv_SC_XOPEN_REALTIME" : C.Int.t;
-val SC_XOPEN_REALTIME_THREADS = _const "Posix_ProcEnv_SC_XOPEN_REALTIME_THREADS" : C.Int.t;
-val SC_XOPEN_SHM = _const "Posix_ProcEnv_SC_XOPEN_SHM" : C.Int.t;
-val SC_XOPEN_STREAMS = _const "Posix_ProcEnv_SC_XOPEN_STREAMS" : C.Int.t;
-val SC_XOPEN_UNIX = _const "Posix_ProcEnv_SC_XOPEN_UNIX" : C.Int.t;
-val SC_XOPEN_VERSION = _const "Posix_ProcEnv_SC_XOPEN_VERSION" : C.Int.t;
-val setenv = _import "Posix_ProcEnv_setenv" : NullString8.t * NullString8.t -> (C.Int.t) C.Errno.t;
-val setgid = _import "Posix_ProcEnv_setgid" : C.GId.t -> (C.Int.t) C.Errno.t;
-val setgroups = _import "Posix_ProcEnv_setgroups" : C.Int.t * (C.GId.t) vector -> (C.Int.t) C.Errno.t;
-val setpgid = _import "Posix_ProcEnv_setpgid" : C.PId.t * C.PId.t -> (C.Int.t) C.Errno.t;
-val setsid = _import "Posix_ProcEnv_setsid" : unit -> (C.PId.t) C.Errno.t;
-val setuid = _import "Posix_ProcEnv_setuid" : C.UId.t -> (C.Int.t) C.Errno.t;
-val sysconf = _import "Posix_ProcEnv_sysconf" : C.Int.t -> (C.Long.t) C.Errno.t;
-val times = _import "Posix_ProcEnv_times" : unit -> (C.Clock.t) C.Errno.t;
-structure Times =
-struct
-val getCSTime = _import "Posix_ProcEnv_Times_getCSTime" : unit -> C.Clock.t;
-val getCUTime = _import "Posix_ProcEnv_Times_getCUTime" : unit -> C.Clock.t;
-val getSTime = _import "Posix_ProcEnv_Times_getSTime" : unit -> C.Clock.t;
-val getUTime = _import "Posix_ProcEnv_Times_getUTime" : unit -> C.Clock.t;
-end
-val ttyname = _import "Posix_ProcEnv_ttyname" : C.Fd.t -> (C.String.t) C.Errno.t;
-val uname = _import "Posix_ProcEnv_uname" : unit -> (C.Int.t) C.Errno.t;
-structure Uname =
-struct
-val getMachine = _import "Posix_ProcEnv_Uname_getMachine" : unit -> C.String.t;
-val getNodeName = _import "Posix_ProcEnv_Uname_getNodeName" : unit -> C.String.t;
-val getRelease = _import "Posix_ProcEnv_Uname_getRelease" : unit -> C.String.t;
-val getSysName = _import "Posix_ProcEnv_Uname_getSysName" : unit -> C.String.t;
-val getVersion = _import "Posix_ProcEnv_Uname_getVersion" : unit -> C.String.t;
-end
-end
-structure Process =
-struct
-val alarm = _import "Posix_Process_alarm" : C.UInt.t -> C.UInt.t;
-val exece = _import "Posix_Process_exece" : NullString8.t * NullString8Array.t * NullString8Array.t -> (C.Int.t) C.Errno.t;
-val execp = _import "Posix_Process_execp" : NullString8.t * NullString8Array.t -> (C.Int.t) C.Errno.t;
-val exit = _import "Posix_Process_exit" : C.Status.t -> unit;
-val exitStatus = _import "Posix_Process_exitStatus" : C.Status.t -> C.Int.t;
-val fork = _import "Posix_Process_fork" : unit -> (C.PId.t) C.Errno.t;
-val ifExited = _import "Posix_Process_ifExited" : C.Status.t -> Bool.t;
-val ifSignaled = _import "Posix_Process_ifSignaled" : C.Status.t -> Bool.t;
-val ifStopped = _import "Posix_Process_ifStopped" : C.Status.t -> Bool.t;
-val kill = _import "Posix_Process_kill" : C.PId.t * C.Signal.t -> (C.Int.t) C.Errno.t;
-val nanosleep = _import "Posix_Process_nanosleep" : (C.Time.t) ref * (C.Long.t) ref -> (C.Int.t) C.Errno.t;
-val pause = _import "Posix_Process_pause" : unit -> (C.Int.t) C.Errno.t;
-val sleep = _import "Posix_Process_sleep" : C.UInt.t -> C.UInt.t;
-val stopSig = _import "Posix_Process_stopSig" : C.Status.t -> C.Signal.t;
-val system = _import "Posix_Process_system" : NullString8.t -> (C.Status.t) C.Errno.t;
-val termSig = _import "Posix_Process_termSig" : C.Status.t -> C.Signal.t;
-structure W =
-struct
-val CONTINUED = _const "Posix_Process_W_CONTINUED" : C.Int.t;
-val NOHANG = _const "Posix_Process_W_NOHANG" : C.Int.t;
-val UNTRACED = _const "Posix_Process_W_UNTRACED" : C.Int.t;
-end
-val waitpid = _import "Posix_Process_waitpid" : C.PId.t * (C.Int.t) ref * C.Int.t -> (C.PId.t) C.Errno.t;
-end
-structure Signal =
-struct
-val default = _import "Posix_Signal_default" : C.Signal.t -> (C.Int.t) C.Errno.t;
-val handlee = _import "Posix_Signal_handlee" : C.Signal.t -> (C.Int.t) C.Errno.t;
-val handleGC = _import "Posix_Signal_handleGC" : unit -> unit;
-val ignore = _import "Posix_Signal_ignore" : C.Signal.t -> (C.Int.t) C.Errno.t;
-val isDefault = _import "Posix_Signal_isDefault" : C.Signal.t * (Bool.t) ref -> (C.Int.t) C.Errno.t;
-val isIgnore = _import "Posix_Signal_isIgnore" : C.Signal.t * (Bool.t) ref -> (C.Int.t) C.Errno.t;
-val isPending = _import "Posix_Signal_isPending" : C.Signal.t -> Bool.t;
-val isPendingGC = _import "Posix_Signal_isPendingGC" : unit -> Bool.t;
-val NSIG = _const "Posix_Signal_NSIG" : C.Int.t;
-val resetPending = _import "Posix_Signal_resetPending" : unit -> unit;
-val SIG_BLOCK = _const "Posix_Signal_SIG_BLOCK" : C.Int.t;
-val SIG_SETMASK = _const "Posix_Signal_SIG_SETMASK" : C.Int.t;
-val SIG_UNBLOCK = _const "Posix_Signal_SIG_UNBLOCK" : C.Int.t;
-val SIGABRT = _const "Posix_Signal_SIGABRT" : C.Signal.t;
-val sigaddset = _import "Posix_Signal_sigaddset" : C.Signal.t -> (C.Int.t) C.Errno.t;
-val SIGALRM = _const "Posix_Signal_SIGALRM" : C.Signal.t;
-val SIGBUS = _const "Posix_Signal_SIGBUS" : C.Signal.t;
-val SIGCHLD = _const "Posix_Signal_SIGCHLD" : C.Signal.t;
-val SIGCONT = _const "Posix_Signal_SIGCONT" : C.Signal.t;
-val sigdelset = _import "Posix_Signal_sigdelset" : C.Signal.t -> (C.Int.t) C.Errno.t;
-val sigemptyset = _import "Posix_Signal_sigemptyset" : unit -> (C.Int.t) C.Errno.t;
-val sigfillset = _import "Posix_Signal_sigfillset" : unit -> (C.Int.t) C.Errno.t;
-val SIGFPE = _const "Posix_Signal_SIGFPE" : C.Signal.t;
-val SIGHUP = _const "Posix_Signal_SIGHUP" : C.Signal.t;
-val SIGILL = _const "Posix_Signal_SIGILL" : C.Signal.t;
-val SIGINT = _const "Posix_Signal_SIGINT" : C.Signal.t;
-val sigismember = _import "Posix_Signal_sigismember" : C.Signal.t -> (C.Int.t) C.Errno.t;
-val SIGKILL = _const "Posix_Signal_SIGKILL" : C.Signal.t;
-val SIGPIPE = _const "Posix_Signal_SIGPIPE" : C.Signal.t;
-val SIGPOLL = _const "Posix_Signal_SIGPOLL" : C.Signal.t;
-val sigprocmask = _import "Posix_Signal_sigprocmask" : C.Int.t -> (C.Int.t) C.Errno.t;
-val SIGPROF = _const "Posix_Signal_SIGPROF" : C.Signal.t;
-val SIGQUIT = _const "Posix_Signal_SIGQUIT" : C.Signal.t;
-val SIGSEGV = _const "Posix_Signal_SIGSEGV" : C.Signal.t;
-val SIGSTOP = _const "Posix_Signal_SIGSTOP" : C.Signal.t;
-val sigsuspend = _import "Posix_Signal_sigsuspend" : unit -> unit;
-val SIGSYS = _const "Posix_Signal_SIGSYS" : C.Signal.t;
-val SIGTERM = _const "Posix_Signal_SIGTERM" : C.Signal.t;
-val SIGTRAP = _const "Posix_Signal_SIGTRAP" : C.Signal.t;
-val SIGTSTP = _const "Posix_Signal_SIGTSTP" : C.Signal.t;
-val SIGTTIN = _const "Posix_Signal_SIGTTIN" : C.Signal.t;
-val SIGTTOU = _const "Posix_Signal_SIGTTOU" : C.Signal.t;
-val SIGURG = _const "Posix_Signal_SIGURG" : C.Signal.t;
-val SIGUSR1 = _const "Posix_Signal_SIGUSR1" : C.Signal.t;
-val SIGUSR2 = _const "Posix_Signal_SIGUSR2" : C.Signal.t;
-val SIGVTALRM = _const "Posix_Signal_SIGVTALRM" : C.Signal.t;
-val SIGXCPU = _const "Posix_Signal_SIGXCPU" : C.Signal.t;
-val SIGXFSZ = _const "Posix_Signal_SIGXFSZ" : C.Signal.t;
-end
-structure SysDB =
-struct
-val getgrgid = _import "Posix_SysDB_getgrgid" : C.GId.t -> Bool.t;
-val getgrnam = _import "Posix_SysDB_getgrnam" : NullString8.t -> Bool.t;
-val getpwnam = _import "Posix_SysDB_getpwnam" : NullString8.t -> Bool.t;
-val getpwuid = _import "Posix_SysDB_getpwuid" : C.GId.t -> Bool.t;
-structure Group =
-struct
-val getGId = _import "Posix_SysDB_Group_getGId" : unit -> C.GId.t;
-val getMem = _import "Posix_SysDB_Group_getMem" : unit -> C.StringArray.t;
-val getName = _import "Posix_SysDB_Group_getName" : unit -> C.String.t;
-end
-structure Passwd =
-struct
-val getDir = _import "Posix_SysDB_Passwd_getDir" : unit -> C.String.t;
-val getGId = _import "Posix_SysDB_Passwd_getGId" : unit -> C.GId.t;
-val getName = _import "Posix_SysDB_Passwd_getName" : unit -> C.String.t;
-val getShell = _import "Posix_SysDB_Passwd_getShell" : unit -> C.String.t;
-val getUId = _import "Posix_SysDB_Passwd_getUId" : unit -> C.UId.t;
-end
-end
-structure TTY =
-struct
-val B0 = _const "Posix_TTY_B0" : C.Speed.t;
-val B110 = _const "Posix_TTY_B110" : C.Speed.t;
-val B1200 = _const "Posix_TTY_B1200" : C.Speed.t;
-val B134 = _const "Posix_TTY_B134" : C.Speed.t;
-val B150 = _const "Posix_TTY_B150" : C.Speed.t;
-val B1800 = _const "Posix_TTY_B1800" : C.Speed.t;
-val B19200 = _const "Posix_TTY_B19200" : C.Speed.t;
-val B200 = _const "Posix_TTY_B200" : C.Speed.t;
-val B2400 = _const "Posix_TTY_B2400" : C.Speed.t;
-val B300 = _const "Posix_TTY_B300" : C.Speed.t;
-val B38400 = _const "Posix_TTY_B38400" : C.Speed.t;
-val B4800 = _const "Posix_TTY_B4800" : C.Speed.t;
-val B50 = _const "Posix_TTY_B50" : C.Speed.t;
-val B600 = _const "Posix_TTY_B600" : C.Speed.t;
-val B75 = _const "Posix_TTY_B75" : C.Speed.t;
-val B9600 = _const "Posix_TTY_B9600" : C.Speed.t;
-structure CFlags =
-struct
-val CLOCAL = _const "Posix_TTY_CFlags_CLOCAL" : C.TCFlag.t;
-val CREAD = _const "Posix_TTY_CFlags_CREAD" : C.TCFlag.t;
-val CS5 = _const "Posix_TTY_CFlags_CS5" : C.TCFlag.t;
-val CS6 = _const "Posix_TTY_CFlags_CS6" : C.TCFlag.t;
-val CS7 = _const "Posix_TTY_CFlags_CS7" : C.TCFlag.t;
-val CS8 = _const "Posix_TTY_CFlags_CS8" : C.TCFlag.t;
-val CSIZE = _const "Posix_TTY_CFlags_CSIZE" : C.TCFlag.t;
-val CSTOPB = _const "Posix_TTY_CFlags_CSTOPB" : C.TCFlag.t;
-val HUPCL = _const "Posix_TTY_CFlags_HUPCL" : C.TCFlag.t;
-val PARENB = _const "Posix_TTY_CFlags_PARENB" : C.TCFlag.t;
-val PARODD = _const "Posix_TTY_CFlags_PARODD" : C.TCFlag.t;
-end
-structure IFlags =
-struct
-val BRKINT = _const "Posix_TTY_IFlags_BRKINT" : C.TCFlag.t;
-val ICRNL = _const "Posix_TTY_IFlags_ICRNL" : C.TCFlag.t;
-val IGNBRK = _const "Posix_TTY_IFlags_IGNBRK" : C.TCFlag.t;
-val IGNCR = _const "Posix_TTY_IFlags_IGNCR" : C.TCFlag.t;
-val IGNPAR = _const "Posix_TTY_IFlags_IGNPAR" : C.TCFlag.t;
-val INLCR = _const "Posix_TTY_IFlags_INLCR" : C.TCFlag.t;
-val INPCK = _const "Posix_TTY_IFlags_INPCK" : C.TCFlag.t;
-val ISTRIP = _const "Posix_TTY_IFlags_ISTRIP" : C.TCFlag.t;
-val IXANY = _const "Posix_TTY_IFlags_IXANY" : C.TCFlag.t;
-val IXOFF = _const "Posix_TTY_IFlags_IXOFF" : C.TCFlag.t;
-val IXON = _const "Posix_TTY_IFlags_IXON" : C.TCFlag.t;
-val PARMRK = _const "Posix_TTY_IFlags_PARMRK" : C.TCFlag.t;
-end
-structure LFlags =
-struct
-val ECHO = _const "Posix_TTY_LFlags_ECHO" : C.TCFlag.t;
-val ECHOE = _const "Posix_TTY_LFlags_ECHOE" : C.TCFlag.t;
-val ECHOK = _const "Posix_TTY_LFlags_ECHOK" : C.TCFlag.t;
-val ECHONL = _const "Posix_TTY_LFlags_ECHONL" : C.TCFlag.t;
-val ICANON = _const "Posix_TTY_LFlags_ICANON" : C.TCFlag.t;
-val IEXTEN = _const "Posix_TTY_LFlags_IEXTEN" : C.TCFlag.t;
-val ISIG = _const "Posix_TTY_LFlags_ISIG" : C.TCFlag.t;
-val NOFLSH = _const "Posix_TTY_LFlags_NOFLSH" : C.TCFlag.t;
-val TOSTOP = _const "Posix_TTY_LFlags_TOSTOP" : C.TCFlag.t;
-end
-structure OFlags =
-struct
-val BS0 = _const "Posix_TTY_OFlags_BS0" : C.TCFlag.t;
-val BS1 = _const "Posix_TTY_OFlags_BS1" : C.TCFlag.t;
-val BSDLY = _const "Posix_TTY_OFlags_BSDLY" : C.TCFlag.t;
-val CR0 = _const "Posix_TTY_OFlags_CR0" : C.TCFlag.t;
-val CR1 = _const "Posix_TTY_OFlags_CR1" : C.TCFlag.t;
-val CR2 = _const "Posix_TTY_OFlags_CR2" : C.TCFlag.t;
-val CR3 = _const "Posix_TTY_OFlags_CR3" : C.TCFlag.t;
-val CRDLY = _const "Posix_TTY_OFlags_CRDLY" : C.TCFlag.t;
-val FF0 = _const "Posix_TTY_OFlags_FF0" : C.TCFlag.t;
-val FF1 = _const "Posix_TTY_OFlags_FF1" : C.TCFlag.t;
-val FFDLY = _const "Posix_TTY_OFlags_FFDLY" : C.TCFlag.t;
-val NL0 = _const "Posix_TTY_OFlags_NL0" : C.TCFlag.t;
-val NL1 = _const "Posix_TTY_OFlags_NL1" : C.TCFlag.t;
-val NLDLY = _const "Posix_TTY_OFlags_NLDLY" : C.TCFlag.t;
-val OCRNL = _const "Posix_TTY_OFlags_OCRNL" : C.TCFlag.t;
-val OFILL = _const "Posix_TTY_OFlags_OFILL" : C.TCFlag.t;
-val ONLCR = _const "Posix_TTY_OFlags_ONLCR" : C.TCFlag.t;
-val ONLRET = _const "Posix_TTY_OFlags_ONLRET" : C.TCFlag.t;
-val ONOCR = _const "Posix_TTY_OFlags_ONOCR" : C.TCFlag.t;
-val OPOST = _const "Posix_TTY_OFlags_OPOST" : C.TCFlag.t;
-val TAB0 = _const "Posix_TTY_OFlags_TAB0" : C.TCFlag.t;
-val TAB1 = _const "Posix_TTY_OFlags_TAB1" : C.TCFlag.t;
-val TAB2 = _const "Posix_TTY_OFlags_TAB2" : C.TCFlag.t;
-val TAB3 = _const "Posix_TTY_OFlags_TAB3" : C.TCFlag.t;
-val TABDLY = _const "Posix_TTY_OFlags_TABDLY" : C.TCFlag.t;
-val VT0 = _const "Posix_TTY_OFlags_VT0" : C.TCFlag.t;
-val VT1 = _const "Posix_TTY_OFlags_VT1" : C.TCFlag.t;
-val VTDLY = _const "Posix_TTY_OFlags_VTDLY" : C.TCFlag.t;
-end
-structure TC =
-struct
-val drain = _import "Posix_TTY_TC_drain" : C.Fd.t -> (C.Int.t) C.Errno.t;
-val flow = _import "Posix_TTY_TC_flow" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val flush = _import "Posix_TTY_TC_flush" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val getattr = _import "Posix_TTY_TC_getattr" : C.Fd.t -> (C.Int.t) C.Errno.t;
-val getpgrp = _import "Posix_TTY_TC_getpgrp" : C.Fd.t -> (C.PId.t) C.Errno.t;
-val sendbreak = _import "Posix_TTY_TC_sendbreak" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val setattr = _import "Posix_TTY_TC_setattr" : C.Fd.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val setpgrp = _import "Posix_TTY_TC_setpgrp" : C.Fd.t * C.PId.t -> (C.Int.t) C.Errno.t;
-val TCIFLUSH = _const "Posix_TTY_TC_TCIFLUSH" : C.Int.t;
-val TCIOFF = _const "Posix_TTY_TC_TCIOFF" : C.Int.t;
-val TCIOFLUSH = _const "Posix_TTY_TC_TCIOFLUSH" : C.Int.t;
-val TCION = _const "Posix_TTY_TC_TCION" : C.Int.t;
-val TCOFLUSH = _const "Posix_TTY_TC_TCOFLUSH" : C.Int.t;
-val TCOOFF = _const "Posix_TTY_TC_TCOOFF" : C.Int.t;
-val TCOON = _const "Posix_TTY_TC_TCOON" : C.Int.t;
-val TCSADRAIN = _const "Posix_TTY_TC_TCSADRAIN" : C.Int.t;
-val TCSAFLUSH = _const "Posix_TTY_TC_TCSAFLUSH" : C.Int.t;
-val TCSANOW = _const "Posix_TTY_TC_TCSANOW" : C.Int.t;
-end
-structure Termios =
-struct
-val cfGetISpeed = _import "Posix_TTY_Termios_cfGetISpeed" : unit -> C.Speed.t;
-val cfGetOSpeed = _import "Posix_TTY_Termios_cfGetOSpeed" : unit -> C.Speed.t;
-val cfSetISpeed = _import "Posix_TTY_Termios_cfSetISpeed" : C.Speed.t -> (C.Int.t) C.Errno.t;
-val cfSetOSpeed = _import "Posix_TTY_Termios_cfSetOSpeed" : C.Speed.t -> (C.Int.t) C.Errno.t;
-val getCC = _import "Posix_TTY_Termios_getCC" : (C.CC.t) array -> unit;
-val getCFlag = _import "Posix_TTY_Termios_getCFlag" : unit -> C.TCFlag.t;
-val getIFlag = _import "Posix_TTY_Termios_getIFlag" : unit -> C.TCFlag.t;
-val getLFlag = _import "Posix_TTY_Termios_getLFlag" : unit -> C.TCFlag.t;
-val getOFlag = _import "Posix_TTY_Termios_getOFlag" : unit -> C.TCFlag.t;
-val setCC = _import "Posix_TTY_Termios_setCC" : (C.CC.t) array -> unit;
-val setCFlag = _import "Posix_TTY_Termios_setCFlag" : C.TCFlag.t -> unit;
-val setIFlag = _import "Posix_TTY_Termios_setIFlag" : C.TCFlag.t -> unit;
-val setLFlag = _import "Posix_TTY_Termios_setLFlag" : C.TCFlag.t -> unit;
-val setOFlag = _import "Posix_TTY_Termios_setOFlag" : C.TCFlag.t -> unit;
-end
-structure V =
-struct
-val NCCS = _const "Posix_TTY_V_NCCS" : C.Int.t;
-val VEOF = _const "Posix_TTY_V_VEOF" : C.Int.t;
-val VEOL = _const "Posix_TTY_V_VEOL" : C.Int.t;
-val VERASE = _const "Posix_TTY_V_VERASE" : C.Int.t;
-val VINTR = _const "Posix_TTY_V_VINTR" : C.Int.t;
-val VKILL = _const "Posix_TTY_V_VKILL" : C.Int.t;
-val VMIN = _const "Posix_TTY_V_VMIN" : C.Int.t;
-val VQUIT = _const "Posix_TTY_V_VQUIT" : C.Int.t;
-val VSTART = _const "Posix_TTY_V_VSTART" : C.Int.t;
-val VSTOP = _const "Posix_TTY_V_VSTOP" : C.Int.t;
-val VSUSP = _const "Posix_TTY_V_VSUSP" : C.Int.t;
-val VTIME = _const "Posix_TTY_V_VTIME" : C.Int.t;
-end
-end
-end
-structure Socket =
-struct
-val accept = _import "Socket_accept" : C.Sock.t * (Word8.t) array * (C.Socklen.t) ref -> (C.Int.t) C.Errno.t;
-structure AF =
-struct
-val INET = _const "Socket_AF_INET" : C.Int.t;
-val INET6 = _const "Socket_AF_INET6" : C.Int.t;
-val UNIX = _const "Socket_AF_UNIX" : C.Int.t;
-val UNSPEC = _const "Socket_AF_UNSPEC" : C.Int.t;
-end
-val bind = _import "Socket_bind" : C.Sock.t * (Word8.t) vector * C.Socklen.t -> (C.Int.t) C.Errno.t;
-val close = _import "Socket_close" : C.Sock.t -> (C.Int.t) C.Errno.t;
-val connect = _import "Socket_connect" : C.Sock.t * (Word8.t) vector * C.Socklen.t -> (C.Int.t) C.Errno.t;
-structure Ctl =
-struct
-val FIONBIO = _const "Socket_Ctl_FIONBIO" : C.Int.t;
-val FIONREAD = _const "Socket_Ctl_FIONREAD" : C.Int.t;
-val getIOCtl = _import "Socket_Ctl_getIOCtl" : C.Sock.t * C.Int.t * (Word8.t) array -> (C.Int.t) C.Errno.t;
-val getPeerName = _import "Socket_Ctl_getPeerName" : C.Sock.t * (Word8.t) array * (C.Socklen.t) ref -> (C.Int.t) C.Errno.t;
-val getSockName = _import "Socket_Ctl_getSockName" : C.Sock.t * (Word8.t) array * (C.Socklen.t) ref -> (C.Int.t) C.Errno.t;
-val getSockOpt = _import "Socket_Ctl_getSockOpt" : C.Sock.t * C.Int.t * C.Int.t * (Word8.t) array * (C.Socklen.t) ref -> (C.Int.t) C.Errno.t;
-val setIOCtl = _import "Socket_Ctl_setIOCtl" : C.Sock.t * C.Int.t * (Word8.t) vector -> (C.Int.t) C.Errno.t;
-val setSockOpt = _import "Socket_Ctl_setSockOpt" : C.Sock.t * C.Int.t * C.Int.t * (Word8.t) vector * C.Socklen.t -> (C.Int.t) C.Errno.t;
-val SIOCATMARK = _const "Socket_Ctl_SIOCATMARK" : C.Int.t;
-val SO_ACCEPTCONN = _const "Socket_Ctl_SO_ACCEPTCONN" : C.Int.t;
-val SO_BROADCAST = _const "Socket_Ctl_SO_BROADCAST" : C.Int.t;
-val SO_DEBUG = _const "Socket_Ctl_SO_DEBUG" : C.Int.t;
-val SO_DONTROUTE = _const "Socket_Ctl_SO_DONTROUTE" : C.Int.t;
-val SO_ERROR = _const "Socket_Ctl_SO_ERROR" : C.Int.t;
-val SO_KEEPALIVE = _const "Socket_Ctl_SO_KEEPALIVE" : C.Int.t;
-val SO_LINGER = _const "Socket_Ctl_SO_LINGER" : C.Int.t;
-val SO_OOBINLINE = _const "Socket_Ctl_SO_OOBINLINE" : C.Int.t;
-val SO_RCVBUF = _const "Socket_Ctl_SO_RCVBUF" : C.Int.t;
-val SO_RCVLOWAT = _const "Socket_Ctl_SO_RCVLOWAT" : C.Int.t;
-val SO_RCVTIMEO = _const "Socket_Ctl_SO_RCVTIMEO" : C.Int.t;
-val SO_REUSEADDR = _const "Socket_Ctl_SO_REUSEADDR" : C.Int.t;
-val SO_SNDBUF = _const "Socket_Ctl_SO_SNDBUF" : C.Int.t;
-val SO_SNDLOWAT = _const "Socket_Ctl_SO_SNDLOWAT" : C.Int.t;
-val SO_SNDTIMEO = _const "Socket_Ctl_SO_SNDTIMEO" : C.Int.t;
-val SO_TYPE = _const "Socket_Ctl_SO_TYPE" : C.Int.t;
-val SOL_SOCKET = _const "Socket_Ctl_SOL_SOCKET" : C.Int.t;
-end
-val familyOfAddr = _import "Socket_familyOfAddr" : (Word8.t) vector -> C.Int.t;
-structure GenericSock =
-struct
-val socket = _import "Socket_GenericSock_socket" : C.Int.t * C.Int.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val socketPair = _import "Socket_GenericSock_socketPair" : C.Int.t * C.Int.t * C.Int.t * (C.Int.t) array -> (C.Int.t) C.Errno.t;
-end
-structure INetSock =
-struct
-structure Ctl =
-struct
-val IPPROTO_TCP = _const "Socket_INetSock_Ctl_IPPROTO_TCP" : C.Int.t;
-val TCP_NODELAY = _const "Socket_INetSock_Ctl_TCP_NODELAY" : C.Int.t;
-end
-val fromAddr = _import "Socket_INetSock_fromAddr" : (Word8.t) vector -> unit;
-val getInAddr = _import "Socket_INetSock_getInAddr" : (Word8.t) array -> unit;
-val getPort = _import "Socket_INetSock_getPort" : unit -> C.Int.t;
-val toAddr = _import "Socket_INetSock_toAddr" : (Word8.t) vector * C.Int.t * (Word8.t) array * (C.Socklen.t) ref -> unit;
-end
-val listen = _import "Socket_listen" : C.Sock.t * C.Int.t -> (C.Int.t) C.Errno.t;
-val MSG_CTRUNC = _const "Socket_MSG_CTRUNC" : C.Int.t;
-val MSG_DONTROUTE = _const "Socket_MSG_DONTROUTE" : C.Int.t;
-val MSG_DONTWAIT = _const "Socket_MSG_DONTWAIT" : C.Int.t;
-val MSG_EOR = _const "Socket_MSG_EOR" : C.Int.t;
-val MSG_OOB = _const "Socket_MSG_OOB" : C.Int.t;
-val MSG_PEEK = _const "Socket_MSG_PEEK" : C.Int.t;
-val MSG_TRUNC = _const "Socket_MSG_TRUNC" : C.Int.t;
-val MSG_WAITALL = _const "Socket_MSG_WAITALL" : C.Int.t;
-val recv = _import "Socket_recv" : C.Sock.t * (Word8.t) array * C.Int.t * C.Size.t * C.Int.t -> (C.SSize.t) C.Errno.t;
-val recvFrom = _import "Socket_recvFrom" : C.Sock.t * (Word8.t) array * C.Int.t * C.Size.t * C.Int.t * (Word8.t) array * (C.Socklen.t) ref -> (C.SSize.t) C.Errno.t;
-val sendArr = _import "Socket_sendArr" : C.Sock.t * (Word8.t) array * C.Int.t * C.Size.t * C.Int.t -> (C.SSize.t) C.Errno.t;
-val sendArrTo = _import "Socket_sendArrTo" : C.Sock.t * (Word8.t) array * C.Int.t * C.Size.t * C.Int.t * (Word8.t) vector * C.Socklen.t -> (C.SSize.t) C.Errno.t;
-val sendVec = _import "Socket_sendVec" : C.Sock.t * (Word8.t) vector * C.Int.t * C.Size.t * C.Int.t -> (C.SSize.t) C.Errno.t;
-val sendVecTo = _import "Socket_sendVecTo" : C.Sock.t * (Word8.t) vector * C.Int.t * C.Size.t * C.Int.t * (Word8.t) vector * C.Socklen.t -> (C.SSize.t) C.Errno.t;
-val SHUT_RD = _const "Socket_SHUT_RD" : C.Int.t;
-val SHUT_RDWR = _const "Socket_SHUT_RDWR" : C.Int.t;
-val SHUT_WR = _const "Socket_SHUT_WR" : C.Int.t;
-val shutdown = _import "Socket_shutdown" : C.Sock.t * C.Int.t -> (C.Int.t) C.Errno.t;
-structure SOCK =
-struct
-val DGRAM = _const "Socket_SOCK_DGRAM" : C.Int.t;
-val RAW = _const "Socket_SOCK_RAW" : C.Int.t;
-val SEQPACKET = _const "Socket_SOCK_SEQPACKET" : C.Int.t;
-val STREAM = _const "Socket_SOCK_STREAM" : C.Int.t;
-end
-val sockAddrStorageLen = _const "Socket_sockAddrStorageLen" : C.Size.t;
-structure UnixSock =
-struct
-val fromAddr = _import "Socket_UnixSock_fromAddr" : (Word8.t) vector * (Char8.t) array * C.Size.t -> unit;
-val pathLen = _import "Socket_UnixSock_pathLen" : (Word8.t) vector -> C.Size.t;
-val toAddr = _import "Socket_UnixSock_toAddr" : NullString8.t * C.Size.t * (Word8.t) array * (C.Socklen.t) ref -> unit;
-end
-end
-structure Stdio =
-struct
-val print = _import "Stdio_print" : String8.t -> unit;
-end
-structure Time =
-struct
-val getTimeOfDay = _import "Time_getTimeOfDay" : unit -> C.Int.t;
-val sec = _import "Time_sec" : unit -> C.Time.t;
-val usec = _import "Time_usec" : unit -> C.SUSeconds.t;
-end
-structure Windows =
-struct
-structure Process =
-struct
-val create = _import "Windows_Process_create" : NullString8.t * NullString8.t * NullString8.t * C.Fd.t * C.Fd.t * C.Fd.t -> (C.PId.t) C.Errno.t;
-val terminate = _import "Windows_Process_terminate" : C.PId.t * C.Signal.t -> (C.Int.t) C.Errno.t;
-end
-end
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.mlb 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,27 +0,0 @@
-(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-ann
- "allowConstant true"
- "allowFFI true"
- "allowPrim true"
- "allowRebindEquals true"
- "deadCode true"
- "nonexhaustiveMatch warn"
- "redundantMatch warn"
- "sequenceNonUnit warn"
- "warnUnused false"
-in
- prim-basis.mlb
- ann "forceUsed" in
- ../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
- end
- primitive.sml
- ann "forceUsed" in
- basis-ffi.sml
- end
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.mlb)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,1695 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-(* Primitive names are special -- see atoms/prim.fun. *)
-
-infix 4 = (* <> > >= < <= *)
-
-val op = = fn z => _prim "MLton_equal": ''a * ''a -> bool; z
-
-structure Char = Char8
-type char = Char.char
-structure Int = Int32
-type int = Int.int
-structure Real = Real64
-type real = Real.real
-
-structure String = String8
-type string = String.string
-
-structure PreThread :> sig type t end = struct type t = Thread.t end
-structure Thread :> sig type t end = struct type t = Thread.t end
-
-structure Word = Word32
-type word = Word.word
-structure LargeWord = Word64
-
-(* NullString is used for strings that must be passed to C and hence must be
- * null terminated. After the Primitive structure is defined,
- * NullString.fromString is replaced by a version that checks that the string
- * is indeed null terminated. See the bottom of this file.
- *)
-structure NullString :>
- sig
- type t
-
- val fromString: string -> t
- end =
- struct
- type t = string
-
- val fromString = fn s => s
- end
-
-structure GetSet =
- struct
- type 'a t = (unit -> 'a) * ('a -> unit)
- end
-
-structure Pid : sig
- eqtype t
-
- val fromInt: int -> t
- val toInt: t -> int
- end =
- struct
- type t = int
-
- val fromInt = fn i => i
- val toInt = fn i => i
- val _ = fromInt
- end
-
-exception Bind = Exn.Bind
-exception Fail of string
-exception Match = Exn.Match
-exception PrimOverflow = Exn.PrimOverflow
-exception Overflow
-exception Size
-
-val wrapOverflow: ('a -> 'b) -> ('a -> 'b) =
- fn f => fn a => f a handle PrimOverflow => raise Overflow
-
-datatype 'a option = NONE | SOME of 'a
-
-fun not b = if b then false else true
-
-functor Comparisons (type t
- val < : t * t -> bool) =
- struct
- fun <= (a, b) = not (< (b, a))
- fun > (a, b) = < (b, a)
- fun >= (a, b) = <= (b, a)
- end
-
-functor RealComparisons (type t
- val < : t * t -> bool
- val <= : t * t -> bool) =
- struct
- fun > (a, b) = < (b, a)
- fun >= (a, b) = <= (b, a)
- end
-
-structure Primitive =
- struct
- val bug = _import "MLton_bug": NullString.t -> unit;
- val debug = _command_line_const "MLton.debug": bool = false;
- val detectOverflow =
- _command_line_const "MLton.detectOverflow": bool = true;
- val eq = _prim "MLton_eq": 'a * 'a -> bool;
- val installSignalHandler =
- _prim "MLton_installSignalHandler": unit -> unit;
- val safe = _command_line_const "MLton.safe": bool = true;
- val touch = _prim "MLton_touch": 'a -> unit;
- val usesCallcc: bool ref = ref false;
-
- structure Stdio =
- struct
- val print = _import "Stdio_print": string -> unit;
- end
-
- structure Array =
- struct
- val array0Const = _prim "Array_array0Const": unit -> 'a array;
- val length = _prim "Array_length": 'a array -> int;
- (* There is no maximum length on arrays, so maxLen = maxInt. *)
- val maxLen: int = 0x7FFFFFFF
- val sub = _prim "Array_sub": 'a array * int -> 'a;
- val update = _prim "Array_update": 'a array * int * 'a -> unit;
- end
-
- structure CString =
- struct
- type t = Pointer.t
- end
-
- structure GCState =
- struct
- type t = Pointer.t
-
- val gcState = #1 _symbol "gcStateAddress": t GetSet.t; ()
- end
-
- structure CallStack =
- struct
- (* The most recent caller is at index 0 in the array. *)
- datatype t = T of int array
-
- val callStack =
- _import "GC_callStack": GCState.t * int array -> unit;
- val frameIndexSourceSeq =
- _import "GC_frameIndexSourceSeq": GCState.t * int -> Pointer.t;
- val keep = _command_line_const "CallStack.keep": bool = false;
- val numStackFrames =
- _import "GC_numStackFrames": GCState.t -> int;
- val sourceName = _import "GC_sourceName": GCState.t * int -> CString.t;
- end
-
- structure Char =
- struct
- open Char
-
- val op < = _prim "WordU8_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord8": int -> char;
- val ord = _prim "WordU8_toWord32": char -> int;
- val toInt8 = _prim "WordS8_toWord8": char -> Int8.int;
- val fromInt8 = _prim "WordS8_toWord8": Int8.int -> char;
- val toWord8 = _prim "WordU8_toWord8": char -> Word8.word;
- val fromWord8 = _prim "WordU8_toWord8": Word8.word -> char;
- end
-
- structure Char =
- struct
- open Char
- local
- structure S = Comparisons (Char)
- in
- open S
- end
- end
-
- structure Char2 =
- struct
- open Char16
-
- val op < = _prim "WordU16_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord16": int -> char;
- val ord = _prim "WordU16_toWord32": char -> int;
- val toInt16 = _prim "WordS16_toWord16": char -> Int16.int;
- val fromInt16 = _prim "WordS16_toWord16": Int16.int -> char;
- (* val toWord16 = _prim "WordU16_toWord16": char -> Word16.word; *)
- (* val fromWord16 = _prim "WordU16_toWord16": Word16.word -> char; *)
- end
-
- structure Char4 =
- struct
- open Char32
-
- val op < = _prim "WordU32_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord32": int -> char;
- val ord = _prim "WordU32_toWord32": char -> int;
- val toInt32 = _prim "WordS32_toWord32": char -> Int32.int;
- val fromInt32 = _prim "WordS32_toWord32": Int32.int -> char;
- (* val toWord32 = _prim "WordU32_toWord32": char -> Word32.word; *)
- (* val fromWord32 = _prim "WordU32_toWord32": Word32.word -> char; *)
- end
-
- structure Exn =
- struct
- (* The polymorphism with extra and setInitExtra is because primitives
- * are only supposed to deal with basic types. The polymorphism
- * allows the various passes like monomorphisation to translate
- * the types appropriately.
- *)
- type extra = CallStack.t option
-
- val extra = _prim "Exn_extra": exn -> 'a;
- val extra: exn -> extra = extra
- val name = _prim "Exn_name": exn -> string;
- val keepHistory =
- _command_line_const "Exn.keepHistory": bool = false;
- val setExtendExtra = _prim "Exn_setExtendExtra": ('a -> 'a) -> unit;
- val setExtendExtra: (extra -> extra) -> unit = setExtendExtra
- val setInitExtra = _prim "Exn_setInitExtra": 'a -> unit;
- val setInitExtra: extra -> unit = setInitExtra
- end
-
- structure FFI =
- struct
- val getOp = #1 _symbol "MLton_FFI_op": int GetSet.t;
- val int8Array = #1 _symbol "MLton_FFI_Int8": Pointer.t GetSet.t; ()
- val int16Array = #1 _symbol "MLton_FFI_Int16": Pointer.t GetSet.t; ()
- val int32Array = #1 _symbol "MLton_FFI_Int32": Pointer.t GetSet.t; ()
- val int64Array = #1 _symbol "MLton_FFI_Int64": Pointer.t GetSet.t; ()
- val numExports = _build_const "MLton_FFI_numExports": int;
- val pointerArray = #1 _symbol "MLton_FFI_Pointer": Pointer.t GetSet.t; ()
- val real32Array = #1 _symbol "MLton_FFI_Real32": Pointer.t GetSet.t; ()
- val real64Array = #1 _symbol "MLton_FFI_Real64": Pointer.t GetSet.t; ()
- val word8Array = #1 _symbol "MLton_FFI_Word8": Pointer.t GetSet.t; ()
- val word16Array = #1 _symbol "MLton_FFI_Word16": Pointer.t GetSet.t; ()
- val word32Array = #1 _symbol "MLton_FFI_Word32": Pointer.t GetSet.t; ()
- val word64Array = #1 _symbol "MLton_FFI_Word64": Pointer.t GetSet.t; ()
- end
-
- structure GC =
- struct
- val collect = _prim "GC_collect": unit -> unit;
- val pack = _import "GC_pack": GCState.t -> unit;
- val setHashConsDuringGC =
- _import "GC_setHashConsDuringGC": GCState.t * bool -> unit;
- val setMessages =
- _import "GC_setMessages": GCState.t * bool -> unit;
- val setRusageMeasureGC =
- _import "GC_setRusageMeasureGC": GCState.t * bool -> unit;
- val setSummary =
- _import "GC_setSummary": GCState.t * bool -> unit;
- val unpack =
- _import "GC_unpack": GCState.t -> unit;
- end
-
- structure Int1 =
- struct
- open Int1
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord1": big -> int;
- val precision' = 1
- val toBig = _prim "WordU1_toWord8": int -> big;
- end
- structure Int2 =
- struct
- open Int2
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord2": big -> int;
- val precision' = 2
- val toBig = _prim "WordU2_toWord8": int -> big;
- end
- structure Int3 =
- struct
- open Int3
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord3": big -> int;
- val precision' = 3
- val toBig = _prim "WordU3_toWord8": int -> big;
- end
- structure Int4 =
- struct
- open Int4
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord4": big -> int;
- val precision' = 4
- val toBig = _prim "WordU4_toWord8": int -> big;
- end
- structure Int5 =
- struct
- open Int5
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord5": big -> int;
- val precision' = 5
- val toBig = _prim "WordU5_toWord8": int -> big;
- end
- structure Int6 =
- struct
- open Int6
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord6": big -> int;
- val precision' = 6
- val toBig = _prim "WordU6_toWord8": int -> big;
- end
- structure Int7 =
- struct
- open Int7
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord7": big -> int;
- val precision' = 7
- val toBig = _prim "WordU7_toWord8": int -> big;
- end
- structure Int8 =
- struct
- type t = Int8.int
- type int = t
-
- val precision' : Int.int = 8
- val maxInt' : int = 0x7f
- val minInt' : int = ~0x80
-
- val *? = _prim "WordS8_mul": int * int -> int;
- val * =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_mulCheck": int * int -> int;)
- else *?
- val +? = _prim "Word8_add": int * int -> int;
- val + =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_addCheck": int * int -> int;)
- else +?
- val -? = _prim "Word8_sub": int * int -> int;
- val - =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_subCheck": int * int -> int;)
- else -?
- val op < = _prim "WordS8_lt": int * int -> bool;
- val quot = _prim "WordS8_quot": int * int -> int;
- val rem = _prim "WordS8_rem": int * int -> int;
- val << = _prim "Word8_lshift": int * Word.word -> int;
- val >> = _prim "WordU8_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS8_rshift": int * Word.word -> int;
- val ~? = _prim "Word8_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word8_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word8_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord8": Int.int -> int;
- val toInt = _prim "WordS8_toWord32": int -> Int.int;
- end
- structure Int8 =
- struct
- open Int8
- local
- structure S = Comparisons (Int8)
- in
- open S
- end
- end
- structure Int9 =
- struct
- open Int9
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord9": big -> int;
- val precision' = 9
- val toBig = _prim "WordU9_toWord16": int -> big;
- end
- structure Int10 =
- struct
- open Int10
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord10": big -> int;
- val precision' = 10
- val toBig = _prim "WordU10_toWord16": int -> big;
- end
- structure Int11 =
- struct
- open Int11
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord11": big -> int;
- val precision' = 11
- val toBig = _prim "WordU11_toWord16": int -> big;
- end
- structure Int12 =
- struct
- open Int12
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord12": big -> int;
- val precision' = 12
- val toBig = _prim "WordU12_toWord16": int -> big;
- end
- structure Int13 =
- struct
- open Int13
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord13": big -> int;
- val precision' = 13
- val toBig = _prim "WordU13_toWord16": int -> big;
- end
- structure Int14 =
- struct
- open Int14
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord14": big -> int;
- val precision' = 14
- val toBig = _prim "WordU14_toWord16": int -> big;
- end
- structure Int15 =
- struct
- open Int15
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord15": big -> int;
- val precision' = 15
- val toBig = _prim "WordU15_toWord16": int -> big;
- end
- structure Int16 =
- struct
- type t = Int16.int
- type int = t
-
- val precision' : Int.int = 16
- val maxInt' : int = 0x7fff
- val minInt' : int = ~0x8000
-
- val *? = _prim "WordS16_mul": int * int -> int;
- val * =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_mulCheck": int * int -> int;))
- else *?
- val +? = _prim "Word16_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word16_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS16_lt": int * int -> bool;
- val quot = _prim "WordS16_quot": int * int -> int;
- val rem = _prim "WordS16_rem": int * int -> int;
- val << = _prim "Word16_lshift": int * Word.word -> int;
- val >> = _prim "WordU16_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS16_rshift": int * Word.word -> int;
- val ~? = _prim "Word16_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word16_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word16_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord16": Int.int -> int;
- val toInt = _prim "WordS16_toWord32": int -> Int.int;
- end
- structure Int16 =
- struct
- open Int16
- local
- structure S = Comparisons (Int16)
- in
- open S
- end
- end
- structure Int17 =
- struct
- open Int17
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord17": big -> int;
- val precision' = 17
- val toBig = _prim "WordU17_toWord32": int -> big;
- end
- structure Int18 =
- struct
- open Int18
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord18": big -> int;
- val precision' = 18
- val toBig = _prim "WordU18_toWord32": int -> big;
- end
- structure Int19 =
- struct
- open Int19
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord19": big -> int;
- val precision' = 19
- val toBig = _prim "WordU19_toWord32": int -> big;
- end
- structure Int20 =
- struct
- open Int20
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord20": big -> int;
- val precision' = 20
- val toBig = _prim "WordU20_toWord32": int -> big;
- end
- structure Int21 =
- struct
- open Int21
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord21": big -> int;
- val precision' = 21
- val toBig = _prim "WordU21_toWord32": int -> big;
- end
- structure Int22 =
- struct
- open Int22
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord22": big -> int;
- val precision' = 22
- val toBig = _prim "WordU22_toWord32": int -> big;
- end
- structure Int23 =
- struct
- open Int23
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord23": big -> int;
- val precision' = 23
- val toBig = _prim "WordU23_toWord32": int -> big;
- end
- structure Int24 =
- struct
- open Int24
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord24": big -> int;
- val precision' = 24
- val toBig = _prim "WordU24_toWord32": int -> big;
- end
- structure Int25 =
- struct
- open Int25
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord25": big -> int;
- val precision' = 25
- val toBig = _prim "WordU25_toWord32": int -> big;
- end
- structure Int26 =
- struct
- open Int26
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord26": big -> int;
- val precision' = 26
- val toBig = _prim "WordU26_toWord32": int -> big;
- end
- structure Int27 =
- struct
- open Int27
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord27": big -> int;
- val precision' = 27
- val toBig = _prim "WordU27_toWord32": int -> big;
- end
- structure Int28 =
- struct
- open Int28
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord28": big -> int;
- val precision' = 28
- val toBig = _prim "WordU28_toWord32": int -> big;
- end
- structure Int29 =
- struct
- open Int29
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord29": big -> int;
- val precision' = 29
- val toBig = _prim "WordU29_toWord32": int -> big;
- end
- structure Int30 =
- struct
- open Int30
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord30": big -> int;
- val precision' = 30
- val toBig = _prim "WordU30_toWord32": int -> big;
- end
- structure Int31 =
- struct
- open Int31
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord31": big -> int;
- val precision' = 31
- val toBig = _prim "WordU31_toWord32": int -> big;
- end
- structure Int32 =
- struct
- type t = Int32.int
- type int = t
-
- val precision' : Int.int = 32
- val maxInt' : int = 0x7fffffff
- val minInt' : int = ~0x80000000
-
- val *? = _prim "WordS32_mul": int * int -> int;
- val * =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_mulCheck": int * int -> int;))
- else *?
- val +? = _prim "Word32_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word32_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS32_lt": int * int -> bool;
- val quot = _prim "WordS32_quot": int * int -> int;
- val rem = _prim "WordS32_rem": int * int -> int;
- val << = _prim "Word32_lshift": int * Word.word -> int;
- val >> = _prim "WordU32_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS32_rshift": int * Word.word -> int;
- val ~? = _prim "Word32_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word32_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word32_andb": int * int -> int;
- val fromInt : int -> int = fn x => x
- val toInt : int -> int = fn x => x
- end
- structure Int32 =
- struct
- open Int32
- local
- structure S = Comparisons (Int32)
- in
- open S
- end
- end
- structure Int = Int32
- structure Int64 =
- struct
- type t = Int64.int
- type int = t
-
- val precision' : Int.int = 64
- val maxInt' : int = 0x7FFFFFFFFFFFFFFF
- val minInt' : int = ~0x8000000000000000
-
- val *? = _prim "WordS64_mul": int * int -> int;
- val * = fn _ => raise Fail "Int64.* unimplemented"
-(*
- val * =
- if detectOverflow
- then _prim "WordS64_mulCheck": int * int -> int;
- else *?
-*)
- val +? = _prim "Word64_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS64_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word64_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS64_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS64_lt": int * int -> bool;
- val << = _prim "Word64_lshift": int * Word.word -> int;
- val >> = _prim "WordU64_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS64_rshift": int * Word.word -> int;
- val quot = _prim "WordS64_quot": int * int -> int;
- val rem = _prim "WordS64_rem": int * int -> int;
- val ~? = _prim "Word64_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word64_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word64_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord64": Int.int -> int;
- val fromWord = _prim "WordU32_toWord64": word -> int;
- val toInt = _prim "WordU64_toWord32": int -> Int.int;
- val toWord = _prim "WordU64_toWord32": int -> word;
- end
- structure Int64 =
- struct
- open Int64
- local
- structure S = Comparisons (Int64)
- in
- open S
- end
- end
-
- structure Array =
- struct
- open Array
-
- val array = _prim "Array_array": int -> 'a array;
- val array =
- fn n => if safe andalso Int.< (n, 0)
- then raise Size
- else array n
- end
-
- structure IntInf =
- struct
- open IntInf
-
- val + = _prim "IntInf_add": int * int * word -> int;
- val andb = _prim "IntInf_andb": int * int * word -> int;
- val ~>> = _prim "IntInf_arshift": int * word * word -> int;
- val compare = _prim "IntInf_compare": int * int -> Int.int;
- val fromVector = _prim "WordVector_toIntInf": word vector -> int;
- val fromWord = _prim "Word_toIntInf": word -> int;
- val gcd = _prim "IntInf_gcd": int * int * word -> int;
- val << = _prim "IntInf_lshift": int * word * word -> int;
- val * = _prim "IntInf_mul": int * int * word -> int;
- val ~ = _prim "IntInf_neg": int * word -> int;
- val notb = _prim "IntInf_notb": int * word -> int;
- val orb = _prim "IntInf_orb": int * int * word -> int;
- val quot = _prim "IntInf_quot": int * int * word -> int;
- val rem = _prim "IntInf_rem": int * int * word -> int;
- val smallMul =
- _import "IntInf_smallMul": word * word * word ref -> word;
- val - = _prim "IntInf_sub": int * int * word -> int;
- val toString
- = _prim "IntInf_toString": int * Int.int * word -> string;
- val toVector = _prim "IntInf_toVector": int -> word vector;
- val toWord = _prim "IntInf_toWord": int -> word;
- val xorb = _prim "IntInf_xorb": int * int * word -> int;
- end
-
- structure MLton =
- struct
- structure Codegen =
- struct
- datatype t = Bytecode | C | Native
-
- val codegen =
- case _build_const "MLton_Codegen_codegen": int; of
- 0 => Bytecode
- | 1 => C
- | 2 => Native
- | _ => raise Fail "MLton_Codegen_codegen"
-
- val isBytecode = codegen = Bytecode
- (* val isC = codegen = C *)
- val isNative = codegen = Native
- end
-
- (* val deserialize = _prim "MLton_deserialize": Word8Vector.vector -> 'a ref; *)
- (* val serialize = _prim "MLton_serialize": 'a ref -> Word8Vector.vector; *)
- val share = _prim "MLton_share": 'a -> unit;
- val size = _prim "MLton_size": 'a ref -> int;
-
- structure Platform =
- struct
- structure Arch =
- struct
- datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
- MIPS | PowerPC | S390 | Sparc | X86
-
- val host: t =
- case _const "MLton_Platform_Arch_host": string; of
- "alpha" => Alpha
- | "amd64" => AMD64
- | "arm" => ARM
- | "hppa" => HPPA
- | "ia64" => IA64
- | "m68k" => m68k
- | "mips" => MIPS
- | "powerpc" => PowerPC
- | "s390" => S390
- | "sparc" => Sparc
- | "x86" => X86
- | _ => raise Fail "strange MLton_Platform_Arch_host"
-
- val hostIsBigEndian =
- _const "MLton_Platform_Arch_bigendian": bool;
- end
-
- structure OS =
- struct
- datatype t =
- Cygwin
- | Darwin
- | FreeBSD
- | Linux
- | MinGW
- | NetBSD
- | OpenBSD
- | Solaris
-
- val host: t =
- case _const "MLton_Platform_OS_host": string; of
- "cygwin" => Cygwin
- | "darwin" => Darwin
- | "freebsd" => FreeBSD
- | "linux" => Linux
- | "mingw" => MinGW
- | "netbsd" => NetBSD
- | "openbsd" => OpenBSD
- | "solaris" => Solaris
- | _ => raise Fail "strange MLton_Platform_OS_host"
-
- val forkIsEnabled =
- case host of
- Cygwin =>
- #1 _symbol "MLton_Platform_CygwinUseMmap": bool GetSet.t; ()
- | MinGW => false
- | _ => true
-
- val useWindowsProcess = not forkIsEnabled
- end
- end
-
- structure Profile =
- struct
- val isOn = _build_const "MLton_Profile_isOn": bool;
- structure Data =
- struct
- type t = word
-
- val dummy:t = 0w0
- val free =
- _import "GC_profileFree": GCState.t * t -> unit;
- val malloc =
- _import "GC_profileMalloc": GCState.t -> t;
- val write =
- _import "GC_profileWrite"
- : GCState.t * t * word (* fd *) -> unit;
- end
- val done = _import "GC_profileDone": GCState.t -> unit;
- val getCurrent =
- _import "GC_getProfileCurrent": GCState.t -> Data.t;
- val setCurrent =
- _import "GC_setProfileCurrent"
- : GCState.t * Data.t -> unit;
- end
-
- structure Weak =
- struct
- open Weak
-
- val canGet = _prim "Weak_canGet": 'a t -> bool;
- val get = _prim "Weak_get": 'a t -> 'a;
- val new = _prim "Weak_new": 'a -> 'a t;
- end
- end
-
- structure PackReal32 =
- struct
- type real = Real32.real
-
- val subVec = _import "PackReal32_subVec": Word8.word vector * int -> real;
- val subVecRev =
- _import "PackReal32_subVecRev": Word8.word vector * int -> real;
- val update =
- _import "PackReal32_update": Word8.word array * int * real -> unit;
- val updateRev =
- _import "PackReal32_updateRev": Word8.word array * int * real -> unit;
- end
-
- structure PackReal64 =
- struct
- type real = Real64.real
-
- val subVec = _import "PackReal64_subVec": Word8.word vector * int -> real;
- val subVecRev =
- _import "PackReal64_subVecRev": Word8.word vector * int -> real;
- val update =
- _import "PackReal64_update": Word8.word array * int * real -> unit;
- val updateRev =
- _import "PackReal64_updateRev": Word8.word array * int * real -> unit;
- end
-
- structure Pointer =
- struct
- open Pointer
-
- val fromWord = _prim "WordU32_toWord32": word -> t;
- val toWord = _prim "WordU32_toWord32": t -> word;
-
- val null: t = fromWord 0w0
-
- fun isNull p = p = null
-
- (* val + = _prim "Pointer_add": t * t -> t; *)
- (* val op < = _prim "Pointer_lt": t * t -> bool; *)
- (* val - = _prim "Pointer_sub": t * t -> t; *)
-(* val free = _import "free": t -> unit; *)
- val getInt8 = _prim "Pointer_getWord8": t * int -> Int8.int;
- val getInt16 = _prim "Pointer_getWord16": t * int -> Int16.int;
- val getInt32 = _prim "Pointer_getWord32": t * int -> Int32.int;
- val getInt64 = _prim "Pointer_getWord64": t * int -> Int64.int;
- val getPointer = _prim "Pointer_getPointer": t * int -> 'a;
- val getReal32 = _prim "Pointer_getReal32": t * int -> Real32.real;
- val getReal64 = _prim "Pointer_getReal64": t * int -> Real64.real;
- val getWord8 = _prim "Pointer_getWord8": t * int -> Word8.word;
- val getWord16 = _prim "Pointer_getWord16": t * int -> Word16.word;
- val getWord32 = _prim "Pointer_getWord32": t * int -> Word32.word;
- val getWord64 = _prim "Pointer_getWord64": t * int -> Word64.word;
- val setInt8 = _prim "Pointer_setWord8": t * int * Int8.int -> unit;
- val setInt16 =
- _prim "Pointer_setWord16": t * int * Int16.int -> unit;
- val setInt32 =
- _prim "Pointer_setWord32": t * int * Int32.int -> unit;
- val setInt64 =
- _prim "Pointer_setWord64": t * int * Int64.int -> unit;
- val setPointer = _prim "Pointer_setPointer": t * int * 'a -> unit;
- val setReal32 =
- _prim "Pointer_setReal32": t * int * Real32.real -> unit;
- val setReal64 =
- _prim "Pointer_setReal64": t * int * Real64.real -> unit;
- val setWord8 =
- _prim "Pointer_setWord8": t * int * Word8.word -> unit;
- val setWord16 =
- _prim "Pointer_setWord16": t * int * Word16.word -> unit;
- val setWord32 =
- _prim "Pointer_setWord32": t * int * Word32.word -> unit;
- val setWord64 =
- _prim "Pointer_setWord64": t * int * Word64.word -> unit;
- end
-
- structure Real64 =
- struct
- open Real64
-
- structure Class =
- struct
- type t = int
-
- val inf = _const "FP_INFINITE": t;
- val nan = _const "FP_NAN": t;
- val normal = _const "FP_NORMAL": t;
- val subnormal = _const "FP_SUBNORMAL": t;
- val zero = _const "FP_ZERO": t;
- end
-
- structure Math =
- struct
- type real = real
-
- val acos = _prim "Real64_Math_acos": real -> real;
- val asin = _prim "Real64_Math_asin": real -> real;
- val atan = _prim "Real64_Math_atan": real -> real;
- val atan2 = _prim "Real64_Math_atan2": real * real -> real;
- val cos = _prim "Real64_Math_cos": real -> real;
- val cosh = _import "cosh": real -> real;
- val e = #1 _symbol "Real64_Math_e": real GetSet.t; ()
- val exp = _prim "Real64_Math_exp": real -> real;
- val ln = _prim "Real64_Math_ln": real -> real;
- val log10 = _prim "Real64_Math_log10": real -> real;
- val pi = #1 _symbol "Real64_Math_pi": real GetSet.t; ()
- val pow = _import "pow": real * real -> real;
- val sin = _prim "Real64_Math_sin": real -> real;
- val sinh = _import "sinh": real -> real;
- val sqrt = _prim "Real64_Math_sqrt": real -> real;
- val tan = _prim "Real64_Math_tan": real -> real;
- val tanh = _import "tanh": real -> real;
- end
-
- val * = _prim "Real64_mul": real * real -> real;
- val *+ = _prim "Real64_muladd": real * real * real -> real;
- val *- = _prim "Real64_mulsub": real * real * real -> real;
- val + = _prim "Real64_add": real * real -> real;
- val - = _prim "Real64_sub": real * real -> real;
- val / = _prim "Real64_div": real * real -> real;
- val op < = _prim "Real64_lt": real * real -> bool;
- val op <= = _prim "Real64_le": real * real -> bool;
- val == = _prim "Real64_equal": real * real -> bool;
- val ?= = _prim "Real64_qequal": real * real -> bool;
- val abs = _prim "Real64_abs": real -> real;
- val class = _import "Real64_class": real -> int;
- val frexp = _import "Real64_frexp": real * int ref -> real;
- val gdtoa =
- _import "Real64_gdtoa": real * int * int * int ref -> CString.t;
- val fromInt = _prim "WordS32_toReal64": int -> real;
- val ldexp = _prim "Real64_ldexp": real * int -> real;
- val maxFinite = #1 _symbol "Real64_maxFinite": real GetSet.t; ()
- val minNormalPos = #1 _symbol "Real64_minNormalPos": real GetSet.t; ()
- val minPos = #1 _symbol "Real64_minPos": real GetSet.t; ()
- val modf = _import "Real64_modf": real * real ref -> real;
- val nextAfter = _import "Real64_nextAfter": real * real -> real;
- val round = _prim "Real64_round": real -> real;
- val signBit = _import "Real64_signBit": real -> int;
- val strto = _import "Real64_strto": NullString.t -> real;
- val toInt = _prim "Real64_toWordS32": real -> int;
- val ~ = _prim "Real64_neg": real -> real;
-
- val fromLarge : real -> real = fn x => x
- val toLarge : real -> real = fn x => x
- val precision : int = 53
- val radix : int = 2
- end
-
- structure Real32 =
- struct
- open Real32
-
- val precision : int = 24
- val radix : int = 2
-
- val fromLarge = _prim "Real64_toReal32": Real64.real -> real;
- val toLarge = _prim "Real32_toReal64": real -> Real64.real;
-
- fun unary (f: Real64.real -> Real64.real) (r: real): real =
- fromLarge (f (toLarge r))
-
- fun binary (f: Real64.real * Real64.real -> Real64.real)
- (r: real, r': real): real =
- fromLarge (f (toLarge r, toLarge r'))
-
- structure Math =
- struct
- type real = real
-
- val acos = _prim "Real32_Math_acos": real -> real;
- val asin = _prim "Real32_Math_asin": real -> real;
- val atan = _prim "Real32_Math_atan": real -> real;
- val atan2 = _prim "Real32_Math_atan2": real * real -> real;
- val cos = _prim "Real32_Math_cos": real -> real;
- val cosh = unary Real64.Math.cosh
- val e = #1 _symbol "Real32_Math_e": real GetSet.t; ()
- val exp = _prim "Real32_Math_exp": real -> real;
- val ln = _prim "Real32_Math_ln": real -> real;
- val log10 = _prim "Real32_Math_log10": real -> real;
- val pi = #1 _symbol "Real32_Math_pi": real GetSet.t; ()
- val pow = binary Real64.Math.pow
- val sin = _prim "Real32_Math_sin": real -> real;
- val sinh = unary Real64.Math.sinh
- val sqrt = _prim "Real32_Math_sqrt": real -> real;
- val tan = _prim "Real32_Math_tan": real -> real;
- val tanh = unary Real64.Math.tanh
- end
-
- val * = _prim "Real32_mul": real * real -> real;
- val *+ = _prim "Real32_muladd": real * real * real -> real;
- val *- = _prim "Real32_mulsub": real * real * real -> real;
- val + = _prim "Real32_add": real * real -> real;
- val - = _prim "Real32_sub": real * real -> real;
- val / = _prim "Real32_div": real * real -> real;
- val op < = _prim "Real32_lt": real * real -> bool;
- val op <= = _prim "Real32_le": real * real -> bool;
- val == = _prim "Real32_equal": real * real -> bool;
- val ?= = _prim "Real32_qequal": real * real -> bool;
- val abs = _prim "Real32_abs": real -> real;
- val class = _import "Real32_class": real -> int;
- fun frexp (r: real, ir: int ref): real =
- fromLarge (Real64.frexp (toLarge r, ir))
- val gdtoa =
- _import "Real32_gdtoa": real * int * int * int ref -> CString.t;
- val fromInt = _prim "WordS32_toReal32": int -> real;
- val ldexp = _prim "Real32_ldexp": real * int -> real;
- val maxFinite = #1 _symbol "Real32_maxFinite": real GetSet.t; ()
- val minNormalPos = #1 _symbol "Real32_minNormalPos": real GetSet.t; ()
- val minPos = #1 _symbol "Real32_minPos": real GetSet.t; ()
- val modf = _import "Real32_modf": real * real ref -> real;
- val signBit = _import "Real32_signBit": real -> int;
- val strto = _import "Real32_strto": NullString.t -> real;
- val toInt = _prim "Real32_toWordS32": real -> int;
- val ~ = _prim "Real32_neg": real -> real;
- end
-
- structure Real32 =
- struct
- open Real32
- local
- structure S = RealComparisons (Real32)
- in
- open S
- end
- end
-
- structure Real64 =
- struct
- open Real64
- local
- structure S = RealComparisons (Real64)
- in
- open S
- end
- end
-
- structure Ref =
- struct
- val deref = _prim "Ref_deref": 'a ref -> 'a;
- val assign = _prim "Ref_assign": 'a ref * 'a -> unit;
- end
-
- structure Status:
- sig
- eqtype t
-
- val failure: t
- val fromInt: int -> t
- val success: t
- val toInt: t -> int
- end =
- struct
- type t = int
-
- val failure = 1
- val fromInt = fn i => i
- val success = 0
- val toInt = fn i => i
- end
-
- val halt = _prim "MLton_halt": Status.t -> unit;
-
- structure String =
- struct
- val fromWord8Vector =
- _prim "Word8Vector_toString": Word8.word vector -> string;
- val toWord8Vector =
- _prim "String_toWord8Vector": string -> Word8.word vector;
- end
-
- structure TextIO =
- struct
- val bufSize = _command_line_const "TextIO.bufSize": int = 4096;
- end
-
- structure Thread =
- struct
- type preThread = PreThread.t
- type thread = Thread.t
-
- val atomicBegin = _prim "Thread_atomicBegin": unit -> unit;
- val canHandle = _prim "Thread_canHandle": unit -> int;
- fun atomicEnd () =
- if Int.<= (canHandle (), 0)
- then raise Fail "Thread.atomicEnd with no atomicBegin"
- else _prim "Thread_atomicEnd": unit -> unit; ()
- val copy = _prim "Thread_copy": preThread -> thread;
- (* copyCurrent's result is accesible via savedPre ().
- * It is not possible to have the type of copyCurrent as
- * unit -> preThread, because there are two different ways to
- * return from the call to copyCurrent. One way is the direct
- * obvious way, in the thread that called copyCurrent. That one,
- * of course, wants to call savedPre (). However, another way to
- * return is by making a copy of the preThread and then switching
- * to it. In that case, there is no preThread to return. Making
- * copyCurrent return a preThread creates nasty bugs where the
- * return code from the CCall expects to see a preThread result
- * according to the C return convention, but there isn't one when
- * switching to a copy.
- *)
- val copyCurrent = _prim "Thread_copyCurrent": unit -> unit;
- val current = _import "GC_getCurrentThread": GCState.t -> thread;
- val finishSignalHandler = _import "GC_finishSignalHandler": GCState.t -> unit;
- val returnToC = _prim "Thread_returnToC": unit -> unit;
- val saved = _import "GC_getSavedThread": GCState.t -> thread;
- val savedPre = _import "GC_getSavedThread": GCState.t -> preThread;
- val setCallFromCHandler =
- _import "GC_setCallFromCHandlerThread": GCState.t * thread -> unit;
- val setSignalHandler = _import "GC_setSignalHandlerThread": GCState.t * thread -> unit;
- val setSaved = _import "GC_setSavedThread": GCState.t * thread -> unit;
- val startSignalHandler = _import "GC_startSignalHandler": GCState.t -> unit;
- val switchTo = _prim "Thread_switchTo": thread -> unit;
- end
-
- structure TopLevel =
- struct
- val setHandler =
- _prim "TopLevel_setHandler": (exn -> unit) -> unit;
- val setSuffix =
- _prim "TopLevel_setSuffix": (unit -> unit) -> unit;
- end
-
- structure Vector =
- struct
- val sub = _prim "Vector_sub": 'a vector * int -> 'a;
- val length = _prim "Vector_length": 'a vector -> int;
-
- (* Don't mutate the array after you apply fromArray, because vectors
- * are supposed to be immutable and the optimizer depends on this.
- *)
- val fromArray = _prim "Array_toVector": 'a array -> 'a vector;
- end
-
- structure Word1 =
- struct
- open Word1
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord1": big -> word;
- val toBig = _prim "WordU1_toWord8": word -> big;
- val wordSize = 1
- end
- structure Word2 =
- struct
- open Word2
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord2": big -> word;
- val toBig = _prim "WordU2_toWord8": word -> big;
- val wordSize = 2
- end
- structure Word3 =
- struct
- open Word3
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord3": big -> word;
- val toBig = _prim "WordU3_toWord8": word -> big;
- val wordSize = 3
- end
- structure Word4 =
- struct
- open Word4
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord4": big -> word;
- val toBig = _prim "WordU4_toWord8": word -> big;
- val wordSize = 4
- end
- structure Word5 =
- struct
- open Word5
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord5": big -> word;
- val toBig = _prim "WordU5_toWord8": word -> big;
- val wordSize = 5
- end
- structure Word6 =
- struct
- open Word6
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord6": big -> word;
- val toBig = _prim "WordU6_toWord8": word -> big;
- val wordSize = 6
- end
- structure Word7 =
- struct
- open Word7
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord7": big -> word;
- val toBig = _prim "WordU7_toWord8": word -> big;
- val wordSize = 7
- end
- structure Word8 =
- struct
- open Word8
-
- val wordSize: int = 8
-
- val + = _prim "Word8_add": word * word -> word;
- val andb = _prim "Word8_andb": word * word -> word;
- val ~>> = _prim "WordS8_rshift": word * Word.word -> word;
- val div = _prim "WordU8_quot": word * word -> word;
- val fromInt = _prim "WordU32_toWord8": int -> word;
- val fromLarge = _prim "WordU64_toWord8": LargeWord.word -> word;
- val << = _prim "Word8_lshift": word * Word.word -> word;
- val op < = _prim "WordU8_lt": word * word -> bool;
- val mod = _prim "WordU8_rem": word * word -> word;
- val * = _prim "WordU8_mul": word * word -> word;
- val ~ = _prim "Word8_neg": word -> word;
- val notb = _prim "Word8_notb": word -> word;
- val orb = _prim "Word8_orb": word * word -> word;
- val rol = _prim "Word8_rol": word * Word.word -> word;
- val ror = _prim "Word8_ror": word * Word.word -> word;
- val >> = _prim "WordU8_rshift": word * Word.word -> word;
- val - = _prim "Word8_sub": word * word -> word;
- val toInt = _prim "WordU8_toWord32": word -> int;
- val toIntX = _prim "WordS8_toWord32": word -> int;
- val toLarge = _prim "WordU8_toWord64": word -> LargeWord.word;
- val toLargeX = _prim "WordS8_toWord64": word -> LargeWord.word;
- val xorb = _prim "Word8_xorb": word * word -> word;
- end
- structure Word8 =
- struct
- open Word8
- local
- structure S = Comparisons (Word8)
- in
- open S
- end
- end
- structure Word8Array =
- struct
- val subWord =
- _prim "Word8Array_subWord": Word8.word array * int -> word;
- val subWordRev =
- _import "Word8Array_subWord32Rev": Word8.word array * int -> word;
- val updateWord =
- _prim "Word8Array_updateWord": Word8.word array * int * word -> unit;
- val updateWordRev =
- _import "Word8Array_updateWord32Rev": Word8.word array * int * word -> unit;
- end
- structure Word8Vector =
- struct
- val subWord =
- _prim "Word8Vector_subWord": Word8.word vector * int -> word;
- val subWordRev =
- _import "Word8Vector_subWord32Rev": Word8.word vector * int -> word;
- end
- structure Word9 =
- struct
- open Word9
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord9": big -> word;
- val toBig = _prim "WordU9_toWord16": word -> big;
- val wordSize = 9
- end
- structure Word10 =
- struct
- open Word10
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord10": big -> word;
- val toBig = _prim "WordU10_toWord16": word -> big;
- val wordSize = 10
- end
- structure Word11 =
- struct
- open Word11
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord11": big -> word;
- val toBig = _prim "WordU11_toWord16": word -> big;
- val wordSize = 11
- end
- structure Word12 =
- struct
- open Word12
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord12": big -> word;
- val toBig = _prim "WordU12_toWord16": word -> big;
- val wordSize = 12
- end
- structure Word13 =
- struct
- open Word13
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord13": big -> word;
- val toBig = _prim "WordU13_toWord16": word -> big;
- val wordSize = 13
- end
- structure Word14 =
- struct
- open Word14
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord14": big -> word;
- val toBig = _prim "WordU14_toWord16": word -> big;
- val wordSize = 14
- end
- structure Word15 =
- struct
- open Word15
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord15": big -> word;
- val toBig = _prim "WordU15_toWord16": word -> big;
- val wordSize = 15
- end
- structure Word16 =
- struct
- open Word16
-
- val wordSize: int = 16
-
- val + = _prim "Word16_add": word * word -> word;
- val andb = _prim "Word16_andb": word * word -> word;
- val ~>> = _prim "WordS16_rshift": word * Word.word -> word;
- val div = _prim "WordU16_quot": word * word -> word;
- val fromInt = _prim "WordU32_toWord16": int -> word;
- val fromLarge = _prim "WordU64_toWord16": LargeWord.word -> word;
- val << = _prim "Word16_lshift": word * Word.word -> word;
- val op < = _prim "WordU16_lt": word * word -> bool;
- val mod = _prim "WordU16_rem": word * word -> word;
- val * = _prim "WordU16_mul": word * word -> word;
- val ~ = _prim "Word16_neg": word -> word;
- val notb = _prim "Word16_notb": word -> word;
- val orb = _prim "Word16_orb": word * word -> word;
- val >> = _prim "WordU16_rshift": word * Word.word -> word;
- val - = _prim "Word16_sub": word * word -> word;
- val toInt = _prim "WordU16_toWord32": word -> int;
- val toIntX = _prim "WordS16_toWord32": word -> int;
- val toLarge = _prim "WordU16_toWord64": word -> LargeWord.word;
- val toLargeX = _prim "WordS16_toWord64": word -> LargeWord.word;
- val xorb = _prim "Word16_xorb": word * word -> word;
-
- val toInt16 = _prim "WordU16_toWord16": word -> Int16.int;
- val fromInt16 = _prim "WordU16_toWord16": Int16.int -> word;
- end
- structure Word16 =
- struct
- open Word16
- local
- structure S = Comparisons (Word16)
- in
- open S
- end
- end
- structure Word17 =
- struct
- open Word17
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord17": big -> word;
- val toBig = _prim "WordU17_toWord32": word -> big;
- val wordSize = 17
- end
- structure Word18 =
- struct
- open Word18
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord18": big -> word;
- val toBig = _prim "WordU18_toWord32": word -> big;
- val wordSize = 18
- end
- structure Word19 =
- struct
- open Word19
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord19": big -> word;
- val toBig = _prim "WordU19_toWord32": word -> big;
- val wordSize = 19
- end
- structure Word20 =
- struct
- open Word20
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord20": big -> word;
- val toBig = _prim "WordU20_toWord32": word -> big;
- val wordSize = 20
- end
- structure Word21 =
- struct
- open Word21
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord21": big -> word;
- val toBig = _prim "WordU21_toWord32": word -> big;
- val wordSize = 21
- end
- structure Word22 =
- struct
- open Word22
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord22": big -> word;
- val toBig = _prim "WordU22_toWord32": word -> big;
- val wordSize = 22
- end
- structure Word23 =
- struct
- open Word23
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord23": big -> word;
- val toBig = _prim "WordU23_toWord32": word -> big;
- val wordSize = 23
- end
- structure Word24 =
- struct
- open Word24
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord24": big -> word;
- val toBig = _prim "WordU24_toWord32": word -> big;
- val wordSize = 24
- end
- structure Word25 =
- struct
- open Word25
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord25": big -> word;
- val toBig = _prim "WordU25_toWord32": word -> big;
- val wordSize = 25
- end
- structure Word26 =
- struct
- open Word26
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord26": big -> word;
- val toBig = _prim "WordU26_toWord32": word -> big;
- val wordSize = 26
- end
- structure Word27 =
- struct
- open Word27
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord27": big -> word;
- val toBig = _prim "WordU27_toWord32": word -> big;
- val wordSize = 27
- end
- structure Word28 =
- struct
- open Word28
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord28": big -> word;
- val toBig = _prim "WordU28_toWord32": word -> big;
- val wordSize = 28
- end
- structure Word29 =
- struct
- open Word29
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord29": big -> word;
- val toBig = _prim "WordU29_toWord32": word -> big;
- val wordSize = 29
- end
- structure Word30 =
- struct
- open Word30
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord30": big -> word;
- val toBig = _prim "WordU30_toWord32": word -> big;
- val wordSize = 30
- end
- structure Word31 =
- struct
- open Word31
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord31": big -> word;
- val toBig = _prim "WordU31_toWord32": word -> big;
- val wordSize = 31
- end
- structure Word32 =
- struct
- open Word32
-
- val wordSize: int = 32
-
- val + = _prim "Word32_add": word * word -> word;
- val andb = _prim "Word32_andb": word * word -> word;
- val ~>> = _prim "WordS32_rshift": word * word -> word;
- val div = _prim "WordU32_quot": word * word -> word;
- val fromInt = _prim "WordU32_toWord32": int -> word;
- val fromLarge = _prim "WordU64_toWord32": LargeWord.word -> word;
- val << = _prim "Word32_lshift": word * word -> word;
- val op < = _prim "WordU32_lt": word * word -> bool;
- val mod = _prim "WordU32_rem": word * word -> word;
- val * = _prim "WordU32_mul": word * word -> word;
- val ~ = _prim "Word32_neg": word -> word;
- val notb = _prim "Word32_notb": word -> word;
- val orb = _prim "Word32_orb": word * word -> word;
- val rol = _prim "Word32_rol": word * word -> word;
- val ror = _prim "Word32_ror": word * word -> word;
- val >> = _prim "WordU32_rshift": word * word -> word;
- val - = _prim "Word32_sub": word * word -> word;
- val toInt = _prim "WordU32_toWord32": word -> int;
- val toIntX = _prim "WordS32_toWord32": word -> int;
- val toLarge = _prim "WordU32_toWord64": word -> LargeWord.word;
- val toLargeX = _prim "WordS32_toWord64": word -> LargeWord.word;
- val xorb = _prim "Word32_xorb": word * word -> word;
-
- val toInt32 = _prim "WordU32_toWord32": word -> Int32.int;
- val fromInt32 = _prim "WordU32_toWord32": Int32.int -> word;
- end
- structure Word32 =
- struct
- open Word32
- local
- structure S = Comparisons (Word32)
- in
- open S
- end
- end
- structure Word = Word32
- structure Word64 =
- struct
- open Word64
-
- val wordSize: int = 64
-
- val + = _prim "Word64_add": word * word -> word;
- val andb = _prim "Word64_andb": word * word -> word;
- val ~>> = _prim "WordS64_rshift": word * Word.word -> word;
- val div = _prim "WordU64_quot": word * word -> word;
- val fromInt = _prim "WordS32_toWord64": int -> word;
- val fromLarge: LargeWord.word -> word = fn x => x
- val << = _prim "Word64_lshift": word * Word.word -> word;
- val op < = _prim "WordU64_lt": word * word -> bool;
- val mod = _prim "WordU64_rem": word * word -> word;
- val * = _prim "WordU64_mul": word * word -> word;
- val ~ = _prim "Word64_neg": word -> word;
- val notb = _prim "Word64_notb": word -> word;
- val orb = _prim "Word64_orb": word * word -> word;
- val >> = _prim "WordU64_rshift": word * Word.word -> word;
- val - = _prim "Word64_sub": word * word -> word;
- val toInt = _prim "WordU64_toWord32": word -> int;
- val toIntX = _prim "WordU64_toWord32": word -> int;
- val toLarge: word -> LargeWord.word = fn x => x
- val toLargeX: word -> LargeWord.word = fn x => x
- val xorb = _prim "Word64_xorb": word * word -> word;
- end
- structure Word64 =
- struct
- open Word64
- local
- structure S = Comparisons (Word64)
- in
- open S
- end
- end
-
- structure Cygwin =
- struct
- val toFullWindowsPath =
- _import "Cygwin_toFullWindowsPath": NullString.t -> CString.t;
- end
-
- structure FileDesc:
- sig
- eqtype t
-
- val fromWord: word -> t
- val fromInt: int -> t
- val toInt: t -> int
- val toWord: t -> word
- end =
- struct
- type t = int
-
- val fromWord = Word32.toInt
- fun fromInt i = i
- fun toInt i = i
- val toWord = Word32.fromInt
- end
-
- structure World =
- struct
- val getAmOriginal = _import "GC_getAmOriginal": GCState.t -> bool;
- val setAmOriginal = _import "GC_setAmOriginal": GCState.t * bool -> unit;
- val save = _prim "World_save": FileDesc.t -> unit;
- end
- end
-
-structure Primitive =
- struct
- open Primitive
-
- structure Int32 =
- struct
- open Int32
-
- local
- fun make f (i: int, i': int): bool =
- f (Primitive.Word32.fromInt i, Primitive.Word32.fromInt i')
- in
- val geu = make Primitive.Word32.>=
- val gtu = make Primitive.Word32.>
- end
- end
- structure Int = Int32
- end
-
-structure NullString =
- struct
- open NullString
-
- fun fromString s =
- if #"\000" = let
- open Primitive
- in
- Vector.sub (s, Int.- (Vector.length s, 1))
- end
- then NullString.fromString s
- else raise Fail "NullString.fromString"
-
- val empty = fromString "\000"
- end
-structure NullString8 = NullString
-structure NullString8Array = struct type t = NullString8.t array end
-
-(* Quell unused warnings. *)
-local
- val _ = #"a": Char16.t: Char16.char
- val _ = #"a": Char32.t: Char32.char
- val _ = "a": String16.t: String16.string
- val _ = "a": String32.t: String32.string
- open Primitive
- open Char2
- val _ = op <
- val _ = chr
- val _ = ord
- open Char4
- val _ = op <
- val _ = chr
- val _ = ord
- open Int64
- val _ = <<
- val _ = >>
- val _ = ~>>
- val _ = andb
-in
-end
-
-(* Install an emergency exception handler. *)
-local
- open Primitive
- val _ =
- TopLevel.setHandler
- (fn exn =>
- (Stdio.print "unhandled exception: "
- ; case exn of
- Fail msg => (Stdio.print "Fail "
- ; Stdio.print msg)
- | _ => Stdio.print (Exn.name exn)
- ; Stdio.print "\n"
- ; bug (NullString.fromString
- "unhandled exception in Basis Library\000")))
-in
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,171 +0,0 @@
-(* modified from SML/NJ sources by Stephen Weeks 1998-6-25 *)
-(* modified by Matthew Fluet 2002-10-11 *)
-(* modified by Matthew Fluet 2002-11-21 *)
-
-(* os-io.sml
- *
- * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
- *
- * NOTE: this interface has been proposed, but not yet adopted by the
- * Standard basis committee.
- *
- *)
-
-structure OS_IO: OS_IO =
- struct
- structure Error = PosixError
-
- (* an iodesc is an abstract descriptor for an OS object that
- * supports I/O (e.g., file, tty device, socket, ...).
- *)
- type iodesc = PreOS.IO.iodesc
-
- datatype iodesc_kind = K of string
-
- type file_desc = Primitive.FileDesc.t
-
- fun toFD (iod: iodesc): file_desc =
- valOf (Posix.FileSys.iodToFD iod)
-
- val FD = Primitive.FileDesc.fromInt
- val unFD = Primitive.FileDesc.toInt
-
- fun fromInt i = Posix.FileSys.fdToIOD (FD i)
-
- val toInt: iodesc -> int = unFD o toFD
-
- val toWord = Posix.FileSys.fdToWord o toFD
-
- (* return a hash value for the I/O descriptor. *)
- val hash = toWord
-
- (* compare two I/O descriptors *)
- fun compare (i, i') = Word.compare (toWord i, toWord i')
-
- structure Kind =
- struct
- val file = K "FILE"
- val dir = K "DIR"
- val symlink = K "LINK"
- val tty = K "TTY"
- val pipe = K "PIPE"
- val socket = K "SOCK"
- val device = K "DEV"
- end
-
- (* return the kind of I/O descriptor *)
- fun kind (iod) = let
- val stat = Posix.FileSys.fstat (toFD iod)
- in
- if (Posix.FileSys.ST.isReg stat) then Kind.file
- else if (Posix.FileSys.ST.isDir stat) then Kind.dir
- else if (Posix.FileSys.ST.isChr stat) then Kind.tty
- else if (Posix.FileSys.ST.isBlk stat) then Kind.device (* ?? *)
- else if (Posix.FileSys.ST.isLink stat) then Kind.symlink
- else if (Posix.FileSys.ST.isFIFO stat) then Kind.pipe
- else if (Posix.FileSys.ST.isSock stat) then Kind.socket
- else K "UNKNOWN"
- end
-
- type poll_flags = {rd: bool, wr: bool, pri: bool}
- datatype poll_desc = PollDesc of iodesc * poll_flags
- datatype poll_info = PollInfo of iodesc * poll_flags
-
- (* create a polling operation on the given descriptor; note that
- * not all I/O devices support polling, but for the time being, we
- * don't test for this.
- *)
- fun pollDesc iod = SOME (PollDesc (iod, {rd=false, wr=false, pri=false}))
-
- (* return the I/O descriptor that is being polled *)
- fun pollToIODesc (PollDesc (iod, _)) = iod
-
- exception Poll
-
- (* set polling events; if the polling operation is not appropriate
- * for the underlying I/O device, then the Poll exception is raised.
- *)
- fun pollIn (PollDesc (iod, {wr, pri, ...}: poll_flags)) =
- PollDesc (iod, {rd=true, wr=wr, pri=pri})
- fun pollOut (PollDesc (iod, {rd, pri, ...}: poll_flags)) =
- PollDesc (iod, {rd=rd, wr=true, pri=pri})
- fun pollPri (PollDesc (iod, {rd, wr, ...}: poll_flags)) =
- PollDesc (iod, {rd=rd, wr=wr, pri=true})
-
- (* polling function *)
- local
- structure Prim = PrimitiveFFI.OS.IO
- fun join (false, _, w) = w
- | join (true, b, w) = Word16.orb(w, b)
- fun test (w, b) = (Word16.andb(w, b) <> 0w0)
- val rdBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLIN
- and wrBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLOUT
- and priBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLPRI
- fun fromPollDesc (PollDesc (iod, {rd, wr, pri})) =
- ( toInt iod,
- Primitive.Word16.toInt16 (
- join (rd, rdBit,
- join (wr, wrBit,
- join (pri, priBit, 0w0))))
- )
- fun toPollInfo (fd, i) =
- let val w = Primitive.Word16.fromInt16 i
- in PollInfo (fromInt fd, {
- rd = test(w, rdBit),
- wr = test(w, wrBit),
- pri = test(w, priBit)
- })
- end
- in
- fun poll (pds, timeOut) = let
- val (fds, eventss) = ListPair.unzip (List.map fromPollDesc pds)
- val fds = Vector.fromList fds
- val n = Vector.length fds
- val eventss = Vector.fromList eventss
- val timeOut =
- case timeOut of
- NONE => ~1
- | SOME t =>
- if Time.< (t, Time.zeroTime)
- then let open PosixError in raiseSys inval end
- else (Int.fromLarge (Time.toMilliseconds t)
- handle Overflow => Error.raiseSys Error.inval)
- val reventss = Array.array (n, 0)
- val _ = Posix.Error.SysCall.simpleRestart
- (fn () => Prim.poll (fds, eventss, C.NFds.fromInt n, timeOut, reventss))
- in
- Array.foldri
- (fn (i, w, l) =>
- if w <> 0
- then (toPollInfo (Vector.sub (fds, i), w))::l
- else l)
- []
- reventss
- end
- end (* local *)
-
- (* check for conditions *)
- fun isIn (PollInfo(_, flgs)) = #rd flgs
- fun isOut (PollInfo(_, flgs)) = #wr flgs
- fun isPri (PollInfo(_, flgs)) = #pri flgs
- fun infoToPollDesc (PollInfo arg) = PollDesc arg
- end (* OS_IO *)
-
-
-(*
- * $Log: os-io.sml, v $
- * Revision 1.4 1997/07/31 17:25:26 jhr
- * We are now using 32-bit ints to represent the seconds portion of a
- * time value. This was required to handle the change in the type of
- * Time.{to, from}{Seconds, Milliseconds, Microseconds}.
- *
- * Revision 1.3 1997/06/07 15:27:51 jhr
- * SML'97 Basis Library changes (phase 3; Posix changes)
- *
- * Revision 1.2 1997/06/02 19:16:19 jhr
- * SML'97 Basis Library changes (phase 2)
- *
- * Revision 1.1.1.1 1997/01/14 01:38:25 george
- * Version 109.24
- *
- *)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/pre-os.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,28 +0,0 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure OS =
- struct
- structure Process =
- struct
- type status = C.Status.t
- end
- structure IO :> sig
- eqtype iodesc
-
- val fromFD: C.Fd.t -> iodesc
- val toFD: iodesc -> C.Fd.t
- end =
- struct
- type iodesc = C.Fd.t
-
- val fromFD = fn z => z
- val toFD = fn z => z
- end
- end
-
-structure PreOS = OS
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/system/pre-os.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,171 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure Time: TIME_EXTRA =
-struct
-
-structure Prim = PrimitiveFFI.Time
-
-(* A time is represented as a number of nanoseconds. *)
-val ticksPerSecond: LargeInt.int = 1000000000
-
-datatype time = T of LargeInt.int
-
-val fromTicks = T
-
-exception Time
-
-val zeroTime = T 0
-
-fun fromReal r =
- T (Real.toLargeInt IEEEReal.TO_NEAREST
- (Real.* (r, Real.fromLargeInt ticksPerSecond)))
- handle Overflow => raise Time
-
-fun toReal (T i) =
- Real./ (Real.fromLargeInt i, Real.fromLargeInt ticksPerSecond)
-
-local
- fun make ticksPer =
- let
- val d = LargeInt.quot (ticksPerSecond, ticksPer)
- in
- (fn i => T (LargeInt.* (i, d)),
- fn T i => LargeInt.quot (i, d))
- end
-in
- val (fromSeconds, toSeconds) = make 1
- val (fromMilliseconds, toMilliseconds) = make 1000
- val (fromMicroseconds, toMicroseconds) = make 1000000
- val (fromNanoseconds, toNanoseconds) = make 1000000000
-end
-
-local
- fun make f (T i, T i') = f (i, i')
-in
- val compare = make LargeInt.compare
- val op < = make LargeInt.<
- val op <= = make LargeInt.<=
- val op > = make LargeInt.>
- val op >= = make LargeInt.>=
-end
-local
- fun make f (T i, T i') = T (f (i, i'))
-in
- val timeAdd = make LargeInt.+
- val timeSub = make LargeInt.-
-end
-
-(* There's a mess here to work around a bug in vmware virtual machines
- * that may return a decreasing(!) sequence of time values. This will
- * cause some programs to raise Time exceptions where it should be
- * impossible.
- *)
-local
- fun getNow (): time =
- (if ~1 = Prim.getTimeOfDay ()
- then raise Fail "Time.now"
- else ()
- ; timeAdd(fromSeconds (C.Time.toLarge (Prim.sec ())),
- fromMicroseconds (C.SUSeconds.toLarge (Prim.usec ()))))
- val prev = ref (getNow ())
-in
- fun now (): time =
- let
- val old = !prev
- val t = getNow ()
- in
- case compare (old, t) of
- GREATER => old
- | _ => (prev := t; t)
- end
-end
-
-val fmt: int -> time -> string =
- fn n => (Real.fmt (StringCvt.FIX (SOME n))) o toReal
-
-val toString = fmt 3
-
-(* Adapted from the ML Kit 4.1.4; basislib/Time.sml
- * by mfluet@acm.org on 2005-11-10 based on
- * by mfluet@acm.org on 2005-8-10 based on
- * adaptations from the ML Kit 3 Version; basislib/Time.sml
- * by sweeks@research.nj.nec.com on 1999-1-3.
- *)
-fun scan getc src =
- let
- val charToDigit = StringCvt.charToDigit StringCvt.DEC
- fun pow10 0 = 1
- | pow10 n = 10 * pow10 (n-1)
- fun mkTime sign intv fracv decs =
- let
- val nsec =
- LargeInt.div (LargeInt.+ (LargeInt.* (Int.toLarge (pow10 (10 - decs)),
- Int.toLarge fracv),
- 5),
- 10)
- val t =
- LargeInt.+ (LargeInt.* (Int.toLarge intv, ticksPerSecond),
- nsec)
- val t = if sign then t else LargeInt.~ t
- in
- T t
- end
- fun frac' sign intv fracv decs src =
- if Int.>= (decs, 7)
- then SOME (mkTime sign intv fracv decs,
- StringCvt.dropl Char.isDigit getc src)
- else case getc src of
- NONE => SOME (mkTime sign intv fracv decs, src)
- | SOME (c, rest) =>
- (case charToDigit c of
- NONE => SOME (mkTime sign intv fracv decs, src)
- | SOME d => frac' sign intv (10 * fracv + d) (decs + 1) rest)
- fun frac sign intv src =
- case getc src of
- NONE => NONE
- | SOME (c, rest) =>
- (case charToDigit c of
- NONE => NONE
- | SOME d => frac' sign intv d 1 rest)
- fun int' sign intv src =
- case getc src of
- NONE => SOME (mkTime sign intv 0 7, src)
- | SOME (#".", rest) => frac sign intv rest
- | SOME (c, rest) =>
- (case charToDigit c of
- NONE => SOME (mkTime sign intv 0 7, src)
- | SOME d => int' sign (10 * intv + d) rest)
- fun int sign src =
- case getc src of
- NONE => NONE
- | SOME (#".", rest) => frac sign 0 rest
- | SOME (c, rest) =>
- (case charToDigit c of
- NONE => NONE
- | SOME d => int' sign d rest)
- in
- case getc (StringCvt.skipWS getc src) of
- NONE => NONE
- | SOME (#"+", rest) => int true rest
- | SOME (#"~", rest) => int false rest
- | SOME (#"-", rest) => int false rest
- | SOME (#".", rest) => frac true 0 rest
- | SOME (c, rest) =>
- (case charToDigit c of
- NONE => NONE
- | SOME d => int' true d rest)
- end
-handle Overflow => raise Time
-
-val fromString = StringCvt.scanString scan
-
-val op + = timeAdd
-val op - = timeSub
-
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml)