1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
#!/usr/bin/env bash
set -e
die () {
echo >&2 "$1"
exit 1
}
bin=`dirname "$0"`
name=`basename "$0"`
usage () {
die "usage: $name <PATH> <ARCH> <OS>"
}
case "$#" in
3)
PATH="$1"
ARCH="$2"
OS="$3"
;;
*)
usage
;;
esac
tmp="$$.sml"
echo "val () = print \"I work\"" >"$tmp"
if ! mlton "$tmp" 1>&2; then
die "Error: cannot upgrade basis because the compiler doesn't work"
fi
feature () {
feature="$1"
sml="$2"
echo "$feature" >"$tmp"
if ! mlton -stop tc "$tmp" >/dev/null 2>&1; then
echo "$sml"
fi
}
feature 'fun f x : string option = TextIO.inputLine x' '
structure TextIO =
struct
open TextIO
fun inputLine ins =
case TextIO.inputLine ins of
"" => NONE
| s => SOME s
end'
feature 'fun f x : string option = OS.FileSys.readDir x' '
structure OS =
struct
open OS
structure FileSys =
struct
open FileSys
fun readDir d =
case FileSys.readDir d of
"" => NONE
| s => SOME s
end
end'
feature 'val _ = IntInf.~>>' '
structure IntInf =
struct
open IntInf
val ~>> : int * Word.word -> int =
fn _ => raise Fail "IntInf.~>>"
end'
feature 'val _ = Real32.+' 'structure Real32 = Real64'
feature 'val _ = Word8.~' '
structure Word8 =
struct
open Word8
fun ~ w = 0w0 - w
end'
feature 'val _ = Word.~' '
structure Word =
struct
open Word
fun ~ w = 0w0 - w
end
structure Word32 = Word
structure LargeWord = Word'
feature 'val _ = PackWord64Big.bytesPerElem' '
structure PackWord64Big : PACK_WORD = struct
val bytesPerElem = 0
val isBigEndian = true
fun subVec _ = raise Fail "PackWord64Big.subVec"
fun subVecX _ = raise Fail "PackWord64Big.subVecX"
fun subArr _ = raise Fail "PackWord64Big.subArr"
fun subArrX _ = raise Fail "PackWord64Big.subArrX"
fun update _ = raise Fail "PackWord64Big.update"
end'
feature 'val _ = PackWord64Little.bytesPerElem' '
structure PackWord64Little : PACK_WORD = struct
val bytesPerElem = 0
val isBigEndian = false
fun subVec _ = raise Fail "PackWord64Little.subVec"
fun subVecX _ = raise Fail "PackWord64Little.subVecX"
fun subArr _ = raise Fail "PackWord64Little.subArr"
fun subArrX _ = raise Fail "PackWord64Little.subArrX"
fun update _ = raise Fail "PackWord64Little.update"
end'
cat <<-EOF
structure MLton =
struct
open MLton
structure Platform =
struct
structure Arch =
struct
type t = string
val host = "$ARCH"
val toString = fn s => s
end
structure OS =
struct
type t = string
val host = "$OS"
val toString = fn s => s
end
end
end
EOF
rm -f "$tmp"
rm -f `basename "$tmp" .sml`
|
