| 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 |