Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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 = fn _ => ~1 | |
13 | structure Exn = | |
14 | struct | |
15 | val history = SMLofNJ.exnHistory | |
16 | end | |
17 | structure GC = | |
18 | struct | |
19 | fun collect () = SMLofNJ.Internals.GC.doGC 8 | |
20 | fun setMessages b = SMLofNJ.Internals.GC.messages b | |
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 |