basis-library/mlton/mlton.sml

   1 (* Copyright (C) 2010,2013,2016-2017 Matthew Fluet.
   2  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 structure MLton: MLTON =
  11 struct
  12
  13 val isMLton = true
  14
  15 (* The ref stuff is so that the (de)serializer always deals with pointers
  16  * to heap objects.
  17  *)
  18 (*       val serialize = fn x => serialize (ref x)
  19  *       val deserialize = fn x => !(deserialize x)
  20  *)
  21
  22 val share = Primitive.MLton.share
  23
  24 structure GC = MLtonGC
  25
  26 fun shareAll () =
  27    (GC.setHashConsDuringGC true
  28     ; GC.collect ())
  29
  30 fun size x =
  31    C_Size.toInt (Primitive.MLton.size x)
  32
  33 (* fun cleanAtExit () = let open Cleaner in clean atExit end *)
  34
  35 val debug = Primitive.Controls.debug
  36 val eq = Primitive.MLton.eq
  37 val equal = Primitive.MLton.equal
  38 val hash = Primitive.MLton.hash
  39 (* val errno = Primitive.errno *)
  40 val safe = Primitive.Controls.safe
  41
  42 structure Array = Array
  43 structure BinIO = MLtonIO (BinIO)
  44 (*structure CallStack = MLtonCallStack*)
  45 structure CharArray = struct
  46    open CharArray
  47    type t = array
  48 end
  49 structure CharVector = struct
  50    open CharVector
  51    type t = vector
  52 end
  53 structure Cont = MLtonCont
  54 structure Exn = MLtonExn
  55 structure Finalizable = MLtonFinalizable
  56 structure IntInf =
  57    struct
  58       open IntInf
  59       type t = int
  60    end
  61 structure Itimer = MLtonItimer
  62 structure LargeReal =
  63    struct
  64       open LargeReal
  65       type t = real
  66    end
  67 structure LargeWord =
  68    struct
  69       open LargeWord
  70       type t = word
  71    end
  72 structure Platform = MLtonPlatform
  73 structure Pointer = MLtonPointer
  74 structure ProcEnv = MLtonProcEnv
  75 structure Process = MLtonProcess
  76 (* structure Ptrace = MLtonPtrace *)
  77 structure Profile = MLtonProfile
  78 structure Random = MLtonRandom
  79 structure Real =
  80    struct
  81       open Real
  82       type t = real
  83    end
  84 structure Real32 =
  85    struct
  86       open Real32
  87       type t = real
  88       open Primitive.PackReal32
  89    end
  90 structure Real64 =
  91    struct
  92       open Real64
  93       type t = real
  94       open Primitive.PackReal64
  95    end
  96 structure Rlimit = MLtonRlimit
  97 structure Rusage = MLtonRusage
  98 structure Signal = MLtonSignal
  99 structure Syslog = MLtonSyslog
 100 structure TextIO = MLtonIO (TextIO)
 101 structure Thread = MLtonThread
 102 structure Vector = Vector
 103 structure Weak = MLtonWeak
 104 structure World = MLtonWorld
 105 structure Word =
 106    struct
 107       open Word
 108       type t = word
 109    end
 110 structure Word8 =
 111    struct
 112       open Word8
 113       type t = word
 114    end
 115 structure Word16 =
 116    struct
 117       open Word16
 118       type t = word
 119    end
 120 structure Word32 =
 121    struct
 122       open Word32
 123       type t = word
 124    end
 125 structure Word64 =
 126    struct
 127       open Word64
 128       type t = word
 129    end
 130 structure Word8Array = struct
 131    open Word8Array
 132    type t = array
 133 end
 134 structure Word8Vector = struct
 135    open Word8Vector
 136    type t = vector
 137 end
 138
 139 val _ =
 140    (Primitive.TopLevel.setHandler MLtonExn.defaultTopLevelHandler
 141     ; Primitive.TopLevel.setSuffix Exit.defaultTopLevelSuffix)
 142 end
 143
 144 (* Patch OS.FileSys.tmpName to use mkstemp. *)
 145 structure OS =
 146    struct
 147       open OS
 148
 149       structure FileSys =
 150          struct
 151             open FileSys
 152
 153             fun tmpName () =
 154                let
 155                   val (f, out) =
 156                       MLton.TextIO.mkstemp (MLton.TextIO.tempPrefix "file")
 157                   val _ = TextIO.closeOut out
 158                in
 159                   f
 160                end
 161          end
 162    end