#!/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'

eval `"$bin/platform"`
case "$ARCH" in
alpha)
        arch='Alpha'
;;
amd64)
        arch='AMD64'
;;
arm)
        arch='ARM'
;;
hppa)
        arch='HPPA'
;;
ia64)
        arch='IA64'
;;
m68k)
        arch='m68k'
;;
mips)
        arch='MIPS'
;;
powerpc)
        arch='PowerPC'
;;
s390)
        arch='S390'
;;
sparc)
        arch='Sparc'
;;
x86)
        arch='X86'
;;
*)
        die "strange HOST_ARCH: $HOST_ARCH"
esac

case "$OS" in
aix)
        os='AIX'
;;
cygwin)
        os='Cygwin'
;;
darwin)
        os='Darwin'
;;
freebsd)
        os='FreeBSD'
;;
hpux)
	os="HPUX"
;;
linux)
        os='Linux'
;;
mingw)
        os='MinGW'
;;
netbsd)
        os='NetBSD'
;;
openbsd)
        os='OpenBSD'
;;
solaris)
        os='Solaris'
;;
*)
        die "strange HOST_OS: $HOST_OS"
;;
esac

cat <<-EOF
structure MLton = 
   struct
      open MLton

      structure Platform =
         struct
            fun peek (l, f) = List.find f l
            fun omap (opt, f) = Option.map f opt
            val toLower = String.translate (str o Char.toLower)

            structure Arch =
               struct
                  datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
                               MIPS | PowerPC | S390 | Sparc | X86

                  val all = [(Alpha, "Alpha"),
                             (AMD64, "AMD64"),
                             (ARM, "ARM"),
                             (HPPA, "HPPA"),
                             (IA64, "IA64"),
                             (m68k, "m68k"),
                             (MIPS, "MIPS"),
                             (PowerPC, "PowerPC"), 
                             (S390, "S390"),
                             (Sparc, "Sparc"), 
                             (X86, "X86")]

                  fun fromString s =
                     let
                        val s = toLower s
                     in
                        omap (peek (all, fn (_, s') => s = toLower s'), #1)
                     end

                  val host = $arch

                  fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
               end

            structure OS =
               struct
                  datatype t = AIX | Cygwin | Darwin | FreeBSD | HPUX | Linux
                             | MinGW | NetBSD | OpenBSD | Solaris

                  val all = [(AIX, "AIX"),
                             (Cygwin, "Cygwin"),
                             (Darwin, "Darwin"),
                             (FreeBSD, "FreeBSD"),
                             (HPUX, "HPUX"),
                             (Linux, "Linux"),
                             (MinGW, "MinGW"),
                             (NetBSD, "NetBSD"),
                             (OpenBSD, "OpenBSD"),
                             (Solaris, "Solaris")]

                  fun fromString s =
                     let
                        val s = toLower s
                     in
                        omap (peek (all, fn (_, s') => s = toLower s'), #1)
                     end

                  val host = $os

                  fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
               end
         end
   end
EOF

rm -f "$tmp"
rm -f `basename "$tmp" .sml`
