| 1 | (* Copyright (C) 2009 Matthew Fluet. |
| 2 | * Copyright (C) 2004-2005 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 MLton = |
| 10 | struct |
| 11 | val isMLton = false |
| 12 | val size : 'a -> int = PolyML.objSize |
| 13 | structure Exn = |
| 14 | struct |
| 15 | val history : exn -> string list = fn _ => [] |
| 16 | end |
| 17 | structure GC = |
| 18 | struct |
| 19 | fun collect () = PolyML.fullGC () |
| 20 | fun setMessages (b : bool) = () |
| 21 | fun pack () = collect () |
| 22 | end |
| 23 | structure Platform = |
| 24 | struct |
| 25 | local |
| 26 | fun mkHost cmd = |
| 27 | let |
| 28 | fun findCmd dir = |
| 29 | let |
| 30 | val cmd = dir ^ "/bin/" ^ cmd |
| 31 | val upDir = OS.FileSys.realPath (dir ^ "/..") |
| 32 | in |
| 33 | if OS.FileSys.access (cmd, [OS.FileSys.A_EXEC]) |
| 34 | then SOME cmd |
| 35 | else if dir <> upDir |
| 36 | then findCmd upDir |
| 37 | else NONE |
| 38 | end |
| 39 | val proc = Unix.execute (valOf (findCmd "."), []) |
| 40 | val ins = Unix.textInstreamOf proc |
| 41 | val hostString = TextIO.inputAll ins |
| 42 | val status = Unix.reap proc |
| 43 | in |
| 44 | String.extract |
| 45 | (hostString, 0, SOME (String.size hostString - 1)) |
| 46 | end |
| 47 | in |
| 48 | structure Arch = |
| 49 | struct |
| 50 | type t = string |
| 51 | val toString = fn s => s |
| 52 | val host = mkHost "host-arch" |
| 53 | end |
| 54 | structure OS = |
| 55 | struct |
| 56 | type t = string |
| 57 | val toString = fn s => s |
| 58 | val host = mkHost "host-os" |
| 59 | end |
| 60 | end |
| 61 | end |
| 62 | end |