comparison repoint @ 2008:55d9bbf1fe45 zoom

Merge from default branch
author Chris Cannam
date Mon, 17 Sep 2018 14:05:41 +0100
parents 1b6ffed298a2
children
comparison
equal deleted inserted replaced
2007:246bdf94ef7b 2008:55d9bbf1fe45
1 #!/bin/bash
2
3 # Disable shellcheck warnings for useless-use-of-cat. UUOC is good
4 # practice, not bad: clearer, safer, less error-prone.
5 # shellcheck disable=SC2002
6
7 sml="$REPOINT_SML"
8
9 set -eu
10
11 # avoid gussying up output
12 export HGPLAIN=true
13
14 mydir=$(dirname "$0")
15 program="$mydir/repoint.sml"
16
17 hasher=
18 local_install=
19 if [ -w "$mydir" ]; then
20 if echo | sha256sum >/dev/null 2>&1 ; then
21 hasher=sha256sum
22 local_install=true
23 elif echo | shasum >/dev/null 2>&1 ; then
24 hasher=shasum
25 local_install=true
26 else
27 echo "WARNING: sha256sum or shasum program not found" 1>&2
28 fi
29 fi
30
31 if [ -n "$local_install" ]; then
32 hash=$(echo "$sml" | cat "$program" - | $hasher | cut -c1-16)
33 gen_sml=$mydir/.repoint-$hash.sml
34 gen_out=$mydir/.repoint-$hash.bin
35 trap 'rm -f $gen_sml' 0
36 else
37 gen_sml=$(mktemp /tmp/repoint-XXXXXXXX.sml)
38 gen_out=$(mktemp /tmp/repoint-XXXXXXXX.bin)
39 trap 'rm -f $gen_sml $gen_out' 0
40 fi
41
42 if [ -x "$gen_out" ]; then
43 exec "$gen_out" "$@"
44 fi
45
46 # We need one of Poly/ML, SML/NJ, MLton, or MLKit. Since we're running
47 # a single-file SML program as if it were a script, our order of
48 # preference is usually based on startup speed. An exception is the
49 # local_install case, where we retain a persistent binary
50
51 if [ -z "$sml" ]; then
52 if [ -n "$local_install" ] && mlton 2>&1 | grep -q 'MLton'; then
53 sml="mlton"
54 elif sml -h 2>&1 | grep -q 'Standard ML of New Jersey'; then
55 sml="smlnj"
56 # We would prefer Poly/ML to SML/NJ, except that Poly v5.7 has a
57 # nasty bug that occasionally causes it to deadlock on startup.
58 # That is fixed in v5.7.1, so we could promote it up the order
59 # again at some point in future
60 elif echo | poly -v 2>/dev/null | grep -q 'Poly/ML'; then
61 sml="polyml"
62 elif mlton 2>&1 | grep -q 'MLton'; then
63 sml="mlton"
64 # MLKit is at the bottom because it leaves compiled files around
65 # in an MLB subdir in the current directory
66 elif mlkit 2>&1 | grep -q 'MLKit'; then
67 sml="mlkit"
68 else cat 1>&2 <<EOF
69
70 ERROR: No supported SML compiler or interpreter found
71 EOF
72 cat 1>&2 <<EOF
73
74 The Repoint external source code manager needs a Standard ML (SML)
75 compiler or interpreter to run.
76
77 Please ensure you have one of the following SML implementations
78 installed and present in your PATH, and try again.
79
80 1. Standard ML of New Jersey
81 - may be found in a distribution package called: smlnj
82 - executable name: sml
83
84 2. Poly/ML
85 - may be found in a distribution package called: polyml
86 - executable name: poly
87
88 3. MLton
89 - may be found in a distribution package called: mlton
90 - executable name: mlton
91
92 4. MLKit
93 - may be found in a distribution package called: mlkit
94 - executable name: mlkit
95
96 EOF
97 exit 2
98 fi
99 fi
100
101 arglist=""
102 for arg in "$@"; do
103 if [ -n "$arglist" ]; then arglist="$arglist,"; fi
104 if echo "$arg" | grep -q '["'"'"']' ; then
105 arglist="$arglist\"usage\""
106 else
107 arglist="$arglist\"$arg\""
108 fi
109 done
110
111 case "$sml" in
112 polyml)
113 if [ -n "$local_install" ] && polyc --help >/dev/null 2>&1 ; then
114 if [ ! -x "$gen_out" ]; then
115 polyc -o "$gen_out" "$program"
116 fi
117 "$gen_out" "$@"
118 else
119 echo 'use "'"$program"'"; repoint ['"$arglist"'];' |
120 poly -q --error-exit
121 fi ;;
122 mlton)
123 if [ ! -x "$gen_out" ]; then
124 echo "[Precompiling Repoint binary...]" 1>&2
125 echo "val _ = main ()" | cat "$program" - > "$gen_sml"
126 mlton -output "$gen_out" "$gen_sml"
127 fi
128 "$gen_out" "$@" ;;
129 mlkit)
130 if [ ! -x "$gen_out" ]; then
131 echo "[Precompiling Repoint binary...]" 1>&2
132 echo "val _ = main ()" | cat "$program" - > "$gen_sml"
133 mlkit -output "$gen_out" "$gen_sml"
134 fi
135 "$gen_out" "$@" ;;
136 smlnj)
137 cat "$program" | (
138 cat <<EOF
139 val smlrun__cp =
140 let val x = !Control.Print.out in
141 Control.Print.out := { say = fn _ => (), flush = fn () => () };
142 x
143 end;
144 val smlrun__prev = ref "";
145 Control.Print.out := {
146 say = fn s =>
147 (if String.isSubstring " Error" s
148 then (Control.Print.out := smlrun__cp;
149 (#say smlrun__cp) (!smlrun__prev);
150 (#say smlrun__cp) s)
151 else (smlrun__prev := s; ())),
152 flush = fn s => ()
153 };
154 EOF
155 cat -
156 cat <<EOF
157 val _ = repoint [$arglist];
158 val _ = OS.Process.exit (OS.Process.success);
159 EOF
160 ) > "$gen_sml"
161 CM_VERBOSE=false sml "$gen_sml" ;;
162 *)
163 echo "ERROR: Unknown SML implementation name: $sml" 1>&2;
164 exit 2 ;;
165 esac
166