basis-library/net/net.sml

   1 (* Copyright (C) 2012 Matthew Fluet.
   2  * Copyright (C) 2002-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 structure Net : NET =
  10    struct
  11       structure AddrFamily = MkAbsRepEq(type rep = C_Int.t)
  12       structure Sock = MkAbsRep(type rep = C_Sock.t)
  13       structure SockType = MkAbsRepEq(type rep = C_Int.t)
  14
  15       structure Prim = PrimitiveFFI.Net
  16
  17       structure Word32 =
  18          struct
  19             val hton = Prim.htonl
  20             val ntoh = Prim.ntohl
  21          end
  22       structure Word16 =
  23          struct
  24             val hton = Prim.htons
  25             val ntoh = Prim.ntohs
  26          end
  27
  28       structure Int32 =
  29          struct
  30             val hton =
  31                Primitive.IntWordConv.idFromWord32ToInt32
  32                o Word32.hton
  33                o Primitive.IntWordConv.idFromInt32ToWord32
  34             val ntoh =
  35                Primitive.IntWordConv.idFromWord32ToInt32
  36                o Word32.ntoh
  37                o Primitive.IntWordConv.idFromInt32ToWord32
  38          end
  39       structure Int16 =
  40          struct
  41             val hton =
  42                Primitive.IntWordConv.idFromWord16ToInt16
  43                o Word16.hton
  44                o Primitive.IntWordConv.idFromInt16ToWord16
  45             val ntoh =
  46                Primitive.IntWordConv.idFromWord16ToInt16
  47                o Word16.ntoh
  48                o Primitive.IntWordConv.idFromInt16ToWord16
  49          end
  50
  51       structure C_Int =
  52          struct
  53             local
  54                structure S =
  55                   C_Int_ChooseIntN
  56                   (type 'a t = 'a -> 'a
  57                    val fInt8 = fn _ => raise Fail "Net.C_Int.hton: fInt8"
  58                    val fInt16 = Int16.hton
  59                    val fInt32 = Int32.hton
  60                    val fInt64 = fn _ => raise Fail "Net.C_Int.hton: fInt64")
  61             in
  62                val hton = S.f
  63             end
  64             local
  65                structure S =
  66                   C_Int_ChooseIntN
  67                   (type 'a t = 'a -> 'a
  68                    val fInt8 = fn _ => raise Fail "Net.C_Int.ntoh: fInt8"
  69                    val fInt16 = Int16.ntoh
  70                    val fInt32 = Int32.ntoh
  71                    val fInt64 = fn _ => raise Fail "Net.C_Int.ntoh: fInt64")
  72             in
  73                val ntoh = S.f
  74             end
  75          end
  76    end