Sonic Lineup

#!/bin/bash

# Disable shellcheck warnings for useless-use-of-cat. UUOC is good

# practice, not bad: clearer, safer, less error-prone.

# shellcheck disable=SC2002

sml="$REPOINT_SML"

set -eu

# avoid gussying up output

export HGPLAIN=true

mydir=$(dirname "$0")

program="$mydir/repoint.sml"

hasher=

local_install=

if [ -w "$mydir" ]; then

    if echo | sha256sum >/dev/null 2>&1 ; then

	hasher=sha256sum

        local_install=true

    elif echo | shasum >/dev/null 2>&1 ; then

	hasher=shasum

	local_install=true

    else

        echo "WARNING: sha256sum or shasum program not found" 1>&2

    fi

fi

if [ -n "$local_install" ]; then

    hash=$(echo "$sml" | cat "$program" - | $hasher | cut -c1-16)

    gen_sml=$mydir/.repoint-$hash.sml

    gen_out=$mydir/.repoint-$hash.bin

    trap 'rm -f $gen_sml' 0

else

    gen_sml=$(mktemp /tmp/repoint-XXXXXXXX.sml)

    gen_out=$(mktemp /tmp/repoint-XXXXXXXX.bin)

    trap 'rm -f $gen_sml $gen_out' 0

fi

if [ -x "$gen_out" ]; then

    exec "$gen_out" "$@"

fi

# We need one of Poly/ML, SML/NJ, MLton, or MLKit. Since we're running

# a single-file SML program as if it were a script, our order of

# preference is usually based on startup speed. An exception is the

# local_install case, where we retain a persistent binary

if [ -z "$sml" ]; then

    if [ -n "$local_install" ] && mlton 2>&1 | grep -q 'MLton'; then

	sml="mlton"

    elif sml -h 2>&1 | grep -q 'Standard ML of New Jersey'; then

	sml="smlnj"

    # We would prefer Poly/ML to SML/NJ, except that Poly v5.7 has a

    # nasty bug that occasionally causes it to deadlock on startup.

    # That is fixed in v5.7.1, so we could promote it up the order

    # again at some point in future

    elif echo | poly -v 2>/dev/null | grep -q 'Poly/ML'; then

	sml="polyml"

    elif mlton 2>&1 | grep -q 'MLton'; then

	sml="mlton"

    # MLKit is at the bottom because it leaves compiled files around

    # in an MLB subdir in the current directory

    elif mlkit 2>&1 | grep -q 'MLKit'; then

	sml="mlkit"

    else cat 1>&2 <<EOF

ERROR: No supported SML compiler or interpreter found

EOF

	cat 1>&2 <<EOF

  The Repoint external source code manager needs a Standard ML (SML)

  compiler or interpreter to run.

  Please ensure you have one of the following SML implementations

  installed and present in your PATH, and try again.

    1. Standard ML of New Jersey

       - may be found in a distribution package called: smlnj

       - executable name: sml

    2. Poly/ML

       - may be found in a distribution package called: polyml

       - executable name: poly

    3. MLton

       - may be found in a distribution package called: mlton

       - executable name: mlton

    4. MLKit

       - may be found in a distribution package called: mlkit

       - executable name: mlkit

EOF

	exit 2

    fi

fi

arglist=""

for arg in "$@"; do

    if [ -n "$arglist" ]; then arglist="$arglist,"; fi

    if echo "$arg" | grep -q '["'"'"']' ; then

	arglist="$arglist\"usage\""

    else

	arglist="$arglist\"$arg\""

    fi

done

case "$sml" in

    polyml)

        if [ -n "$local_install" ] && polyc --help >/dev/null 2>&1 ; then

            if [ ! -x "$gen_out" ]; then

                polyc -o "$gen_out" "$program"

            fi

	    "$gen_out" "$@"

        else

            echo 'use "'"$program"'"; repoint ['"$arglist"'];' |

                poly -q --error-exit

        fi ;;

    mlton)

        if [ ! -x "$gen_out" ]; then

	    echo "[Precompiling Repoint binary...]" 1>&2

	    echo "val _ = main ()" | cat "$program" - > "$gen_sml"

	    mlton -output "$gen_out" "$gen_sml"

        fi

	"$gen_out" "$@" ;;

    mlkit)

        if [ ! -x "$gen_out" ]; then

	    echo "[Precompiling Repoint binary...]" 1>&2

	    echo "val _ = main ()" | cat "$program" - > "$gen_sml"

	    mlkit -output "$gen_out" "$gen_sml"

        fi

	"$gen_out" "$@" ;;

    smlnj)

	cat "$program" | (

	    cat <<EOF

val smlrun__cp =

    let val x = !Control.Print.out in

        Control.Print.out := { say = fn _ => (), flush = fn () => () };

        x

    end;

val smlrun__prev = ref "";

Control.Print.out := {

    say = fn s =>

        (if String.isSubstring " Error" s

         then (Control.Print.out := smlrun__cp;

               (#say smlrun__cp) (!smlrun__prev);

               (#say smlrun__cp) s)

         else (smlrun__prev := s; ())),

    flush = fn s => ()

};

EOF

	    cat -

	    cat <<EOF

val _ = repoint [$arglist];

val _ = OS.Process.exit (OS.Process.success);

EOF

            ) > "$gen_sml"

	CM_VERBOSE=false sml "$gen_sml" ;;

    *)

	echo "ERROR: Unknown SML implementation name: $sml" 1>&2;

	exit 2 ;;

esac