[MLton-commit] r4463
Matthew Fluet
MLton@mlton.org
Sat, 6 May 2006 09:28:47 -0700
Refactor MLton.Socket
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-06 16:28:46 UTC (rev 4463)
@@ -340,8 +340,8 @@
(* ../mlton/ptrace.sml *)
../mlton/rlimit.sig
../mlton/rlimit.sml
- (* ../mlton/socket.sig *)
- (* ../mlton/socket.sml *)
+ ../mlton/socket.sig
+ ../mlton/socket.sml
../mlton/syslog.sig
../mlton/syslog.sml
../mlton/vector.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/top-level/basis-sigs.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -101,7 +101,7 @@
signature MLTON_RLIMIT = MLTON_RLIMIT
signature MLTON_RUSAGE = MLTON_RUSAGE
signature MLTON_SIGNAL = MLTON_SIGNAL
-(* signature MLTON_SOCKET = MLTON_SOCKET *)
+signature MLTON_SOCKET = MLTON_SOCKET
signature MLTON_SYSLOG = MLTON_SYSLOG
signature MLTON_TEXT_IO = MLTON_TEXT_IO
signature MLTON_THREAD = MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-06 16:28:46 UTC (rev 4463)
@@ -42,7 +42,7 @@
structure Rlimit: MLTON_RLIMIT
structure Rusage: MLTON_RUSAGE
structure Signal: MLTON_SIGNAL
-(* structure Socket: MLTON_SOCKET *)
+ structure Socket: MLTON_SOCKET
structure Syslog: MLTON_SYSLOG
structure TextIO: MLTON_TEXT_IO
structure Thread: MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -63,7 +63,7 @@
structure Rlimit = MLtonRlimit
structure Rusage = MLtonRusage
structure Signal = MLtonSignal
-(* structure Socket = MLtonSocket *)
+structure Socket = MLtonSocket
structure Syslog = MLtonSyslog
structure TextIO = MLtonIO (TextIO)
structure Thread = MLtonThread
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sig 2006-05-06 16:28:46 UTC (rev 4463)
@@ -6,14 +6,11 @@
* See the file MLton-LICENSE for details.
*)
-type int = Int.int
-type word = Word.word
-
signature MLTON_SOCKET =
sig
structure Address:
sig
- type t = word
+ type t
end
structure Ctl:
@@ -33,7 +30,7 @@
structure Port:
sig
- type t = int
+ type t
end
type t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/socket.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -16,7 +16,7 @@
structure Address =
struct
- type t = word
+ type t = NetHostDB.in_addr
end
structure Host =
@@ -26,7 +26,7 @@
val get: NetHostDB.entry option -> t option =
Option.map (fn entry => {name = NetHostDB.name entry})
- val getByAddress = get o NetHostDB.getByAddr o NetHostDB.wordToInAddr
+ val getByAddress = get o NetHostDB.getByAddr
val getByName = get o NetHostDB.getByName
end
@@ -75,7 +75,7 @@
val (in_addr: NetHostDB.in_addr, port: int) = INetSock.fromAddr addr
val (ins, out) = sockToIO sock
in
- (NetHostDB.inAddrToWord in_addr, port, ins, out)
+ (in_addr, port, ins, out)
end
fun connect (host, port) =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton.mlb 2006-05-06 16:28:46 UTC (rev 4463)
@@ -33,7 +33,7 @@
signature MLTON_RLIMIT
signature MLTON_RUSAGE
signature MLTON_SIGNAL
- (* signature MLTON_SOCKET *)
+ signature MLTON_SOCKET
signature MLTON_SYSLOG
signature MLTON_TEXT_IO
signature MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-06 16:28:46 UTC (rev 4463)
@@ -18,23 +18,29 @@
val inetAF = PrimitiveFFI.Socket.AF.INET
fun toAddr (in_addr, port) =
- if port < 0 orelse port >= 0x10000
- then PosixError.raiseSys PosixError.inval
- else let
- val port = Net.C_Int.hton (C_Int.fromInt port)
- val (sa, salen, finish) = Socket.new_sock_addr ()
- val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
- port, sa, salen)
- in
- finish ()
- end
+ let
+ val port = C_Int.fromInt port
+ val port = Net.C_Int.hton port
+ in
+ if C_Int.< (port, 0) orelse C_Int.>= (port, 0x10000)
+ then PosixError.raiseSys PosixError.inval
+ else let
+ val (sa, salen, finish) = Socket.new_sock_addr ()
+ val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
+ port, sa, salen)
+ in
+ finish ()
+ end
+ end
fun any port = toAddr (NetHostDB.any (), port)
fun fromAddr sa =
let
- val _ = Prim.fromAddr (Socket.unpackSockAddr sa)
- val port = C_Int.toInt (Net.C_Int.ntoh (Prim.getPort ()))
+ val () = Prim.fromAddr (Socket.unpackSockAddr sa)
+ val port = Prim.getPort ()
+ val port = Net.C_Int.ntoh port
+ val port = C_Int.toInt port
val (ia, finish) = NetHostDB.new_in_addr ()
val _ = Prim.getInAddr (NetHostDB.preInAddrToWord8Array ia)
in
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c 2006-05-06 15:35:55 UTC (rev 4462)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/Net.c 2006-05-06 16:28:46 UTC (rev 4463)
@@ -1,17 +1,33 @@
#include "platform.h"
+#ifndef DEBUG
+#define DEBUG FALSE
+#endif
+
Word32_t Net_htonl (Word32_t w) {
- return htonl (w);
+ Word32_t r = htonl (w);
+ if (DEBUG)
+ printf ("%"PRIx32" = Net_htonl (%"PRIx32")\n", r, w);
+ return r;
}
Word32_t Net_ntohl (Word32_t w) {
- return ntohl (w);
+ Word32_t r = ntohl (w);
+ if (DEBUG)
+ printf ("%"PRIx32" = Net_ntohl (%"PRIx32")\n", r, w);
+ return r;
}
Word16_t Net_htons (Word16_t w) {
- return htons (w);
+ Word16_t r = htons (w);
+ if (DEBUG)
+ printf ("%"PRIx16" = Net_htonl (%"PRIx16")\n", r, w);
+ return r;
}
Word16_t Net_ntohs (Word16_t w) {
- return ntohs (w);
+ Word16_t r = ntohs (w);
+ if (DEBUG)
+ printf ("%"PRIx16" = Net_ntohl (%"PRIx16")\n", r, w);
+ return r;
}